Optimize macro for millions of calculations - excel

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

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 2

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 3

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.

Answer 4

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