There is a way to improve the execution time?

Question

I'm developing a VBA code that is responsible for searching in a excel file the value of a cell (serial number) and its production start date. After that, its searches on a Access databse for that same serial number and writes on the especified column the date. The problem is that it's taking hours to end, because the excel and the database have more than 10000 rows... The question is: there is a way that I can improve my code to run faster?

Private Sub Comando9_Click()
 Set db = CurrentDb.OpenRecordset("ConsultaNSerie", dbOpenDynaset)
 Set appExcel = CreateObject("Excel.Application")
'appExcel.Visible = True
 appExcel.Application.Workbooks.Open "K:\EM HP - Comum\Planejamento de 
 Produção HP\CB\Planejamento de Produção_CB_FY19-20\Planejamento de 
 Produção_CB_FY19-20.xlsm"

 Dim Inicio_planejado As Variant
 Dim Numero_serie As String
 Dim SAP As String
 i = 9

 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Dim Fileout As Object
 Set Fileout = fso.CreateTextFile("K:\EM HP - Engenharia\02-Aplicação\11- 
 Controle de Projetos\Nserie_NoMatch.txt", True, True)

 Do
     SAP = appExcel.Sheets("Disjuntores").Columns("I").Rows(i).Value
     Numero_serie = appExcel.Sheets("Disjuntores").Columns("L").Rows(i).Value
     'MsgBox (Numero_serie)
     Inicio_planejado = 
     appExcel.Sheets("Disjuntores").Columns("T").Rows(i).Value

    If Inicio_planejado <> "" Then
        'MsgBox (Inicio_planejado)
        'quando for vazio, desconsiderar a celula
        'ThisWorkbook.Reg.FindFirst "[OF] = '" + cb_OF.Value + " '"
        db.FindNext "[NUMERO_SERIE] = '" + Numero_serie + " '"
        If db.NoMatch Then
            db.FindPrevious "[NUMERO_SERIE] = '" + Numero_serie + " '"
        ElseIf db.NoMatch Then
            Fileout.Write Numero_serie & "  "
            'MsgBox ("Número de série " + Numero_serie + " não encontrado")
        Else
            'Adicionar o valor de "Inicio_planejado" aos campos na coluna 
     "INICIO_FBR"
            db.Edit
            db![INICIO_FBR] = Inicio_planejado
            db.Update
            db.MoveNext
        End If
End If

i = i + 1

Loop Until appExcel.Sheets("Disjuntores").cells(i, 7) = ""

Fileout.Close
appExcel.Quit

End Sub

Answer 1

1) Don't use db.FindNext and db.FindPrevious with the same search criterium. That makes no sense for your situation.

Use only FindFirst, and get rid of the db.MoveNext:

    db.FindFirst "[NUMERO_SERIE] = '" + Numero_serie + " '"
    If db.NoMatch Then
        Fileout.Write Numero_serie & "  "
    Else
        db.Edit
        db![INICIO_FBR] = Inicio_planejado
        db.Update
        ' Remove this, is is of no use:
        '--- db.MoveNext
    End If

2) In Access, edit the table ConsultaNSerie and add an index on NUMERO_SERIE.