Optimize macro for millions of calculations

Question

I'm matching ids on separate files, if a match happens the row on the source gets retrieved to the other file. I did a FOR statement for both files to scan each row, the source workbook has over 27000 rows and the other about 8000, if I understand right that is 216M+ calculations until the end of the loops. I've implemented screenUpdating = False and xlCalculationManual. But here am I, I've waited about 30 minutes and there is no sign of the code finishing (both VBA editor and Excel are "not responding").

For filaIndiceFuente = 2 To filaFuenteUltima
    criterioFuente = planillaFuente.Range("A" & filaIndiceFuente).Value
    For filaIndiceDestino = 2 To filaDestinoUltima
        ' filaIndiceDestino = filaIndiceDestino + 1
        If planillaDestino.Range("A" & filaIndiceDestino).Value = criterioFuente Then

        'CELLS GET TO THE OTHER FILE HERE

        End If
    Next filaIndiceDestino
Next filaIndiceFuente

On test files I implemented the code and it runs almost instantly with positive results. If you could hint me other ways of improving my code I'll be thankful.

Answer 1

I would probably take it a step further, load the data into arrays, then loop through the arrays. The indice will be off by 1 due the offset on reading the array data. There is a bit of fluff in the loadscp routine, I built it for reuse. I suspect you won’t need the status bar.

Dim scpFuente   As scripting.dictionary
Dim arrFuente    As variant 
Dim arrDest       As variant 

Arrfuente = planillaFuente.range(“a2”).resize(filaFuenteUltima-1,1).value
ArrDest = planillaDestino.range(“a2”).resize(filaDestinaUltima-1,1).value

Set scpFuente = loadscp(arrfuente)


For filaIndiceDestino = lbound(arrDest,1) to ubound(arrDest,1) 
    ' filaIndiceDestino = filaIndiceDestino + 1
    If scpFuente.exists(arrdest(filaindicedestino,1)) Then

    'CELLS GET TO THE OTHER FILE HERE

    End If
Next filaIndiceDestino

The loadscp function:

Public Function Loadscp(ByVal varList As Variant, Optional ByVal intCol As Integer = 1, _
Optional ByVal intCols As Integer = 1, Optional ByVal strDelim As String = ".") As Scripting.Dictionary

Dim scpList             As Scripting.Dictionary

Dim arrVals             As Variant

Dim lngLastRow          As Long
Dim lngRow              As Long
Dim intABSCol           As Integer
Dim intColCurr          As Integer
Dim strVal              As String
Dim intRngCol           As Integer

Set Loadscp = New Scripting.Dictionary
Loadscp.CompareMode = vbTextCompare

intABSCol = Abs(intCol)
If IsArray(varList) Then
    arrVals = varList
ElseIf TypeName(varList) = "Range" Then
    intRngCol = varList.Column
    lngLastRow = LastRow(varList.Parent, intCol)

    If lngLastRow > varList.Row Then
        arrVals = varList.Offset(1, intABSCol - 1).Resize(lngLastRow - varList.Row, 1)
    End If
ElseIf TypeName(varList) = "Dictionary" Then
    Set scpList = varList
    ReDim arrVals(1 To scpList.Count, 1 To 1)
    For lngRow = 1 To scpList.Count
        arrVals(lngRow, 1) = scpList.Keys(lngRow - 1)
    Next lngRow
End If

If IsArray(arrVals) Then
    For lngRow = LBound(arrVals, 1) To UBound(arrVals, 1)
        strVal = arrVals(lngRow, intCol)
        For intColCurr = intCol + 1 To intCol + intCols - 1
            strVal = strVal & strDelim & arrVals(lngRow, intColCurr)
        Next intColCurr
        If Not Loadscp.Exists(strVal) Then
            Loadscp.Item(strVal) = lngRow
        End If
    Next lngRow
End If

End Function

Answer 2

First sort the planillaDest range ascending by column A, then:

Dim lookupRange As Range
Set lookupRange = planillaDestino.Range("A2:A" & filaDestinoUltima)

For filaIndiceFuente = 2 To filaFuenteUltima
    criterioFuente = planillaFuente.Cells(filaIndiceFuente, "A").Value
    Dim matchRow As Long
    matchRow = Application.WorksheetFunction.Match(criterioFuente, lookupRange, 1)
    If lookupRange.Cells(matchRow, 1).Value = criterioFuente Then
        'CELLS GET TO THE OTHER FILE HERE
        ' If row to move from planillaFuente to planillaDest, then:
        planillaDest.Cells(matchRow + 1, "P").Value = planillaFuente.Cells(filaIndiceFuente, "D").Value

    End If
Next filaIndiceFuente

Answer 3

Usually when I have a large dataset that I'm iterating through for matches, I find that using a Dictionary is faster even than a .Find() operation or iterating through every row.

I would try something like

Dim dict As New Scripting.Dictionary

For filaIndiceFuente = 2 To filaFuenteUltima
    dict.Add CStr(planillaFuente.Range("A" & filaIndiceFuente).Value), filaIndiceFuente '<- this will act as a pointer to the row where your match data is
Next filaIndiceFuente

For filaIndiceDestino = 2 To filaDestinoUltima
    If dict.Exists(CStr(planillaDestino.Range("A" & filaIndiceDestino).Value)) Then
        'CELLS GET TO THE OTHER FILE HERE
    End If
Next filaIndiceDestino

Set dict = Nothing

Answer 4

First I would add Application.Statusbar value to control how long it is running Second I would add an exit for if a value is found in the inner loop to prevent unneccessary steps in the loop like :

For filaIndiceFuente = 2 To filaFuenteUltima
    criterioFuente = planillaFuente.Range("A" & filaIndiceFuente).Value
    if filaIndiceFuente  mod 50 = 0 then 
      **Application.statusbar = filaIndiceFuente**  
    end if
    For filaIndiceDestino = 2 To filaDestinoUltima
        ' filaIndiceDestino = filaIndiceDestino + 1
        If planillaDestino.Range("A" & filaIndiceDestino).Value = criterioFuente Then

        'CELLS GET TO THE OTHER FILE HERE
        **exit for**
        End If
    Next filaIndiceDestino
Next filaIndiceFuente
Application.statusbar = ""

You can have the statusbar info inside the inner loop

For filaIndiceFuente = 2 To filaFuenteUltima
    criterioFuente = planillaFuente.Range("A" & filaIndiceFuente).Value

    For filaIndiceDestino = 2 To filaDestinoUltima
        ' filaIndiceDestino = filaIndiceDestino + 1
        if filaIndiceDestino mod 50 = 0 then 
            **Application.statusbar = filaIndiceFuente & " - " & filaIndiceDestino **  
        end if
        If planillaDestino.Range("A" & filaIndiceDestino).Value = criterioFuente Then

        'CELLS GET TO THE OTHER FILE HERE
        **exit for**
        End If
    Next filaIndiceDestino
Next filaIndiceFuente
Application.statusbar = ""

I do not see a way to make comparsion faster, but maybe some other has a better idea. See this as a first step to identify the reason for taking a long time.