Macro Theory Question

[Peteor]

Team,

I routinely find myself using For Each loops with embedded If statements to quickly parse down Excel data, and place various values on other sheets. Although not optimal, for smaller Excel sheets this has always quickly worked for me. I am being handed a project based on my Excel knowledge where I have to parse through 10+ 1,000,000 Row Worksheets. For a project this size, I do believe my routine method will be too clunky/slow. Does anyone have any recommendations for a better high volume method? One shortcoming of this method I have found previously is the number of times it loops through Cel & Cel2, however I have never figured out how to break the extra loop. Below is an example of what I would typically use.

Sub Peteor()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Cel As Range
Dim Rng As Range
Dim Cel2 As Range
Dim Rng2 As Range

Set Rng = Worksheets("Sheet1").Range("B2:B10000)
Set Rng2 = Worksheets("Sheet2").Range("C2:C10000)

For Each Cel In Rng
For Each Cel2 In Rng2
    
     If Cel.Value = Cel2.Value Then
             
          Worksheets("Sheet3").Range("F" & Rows.Count).End(xlUp).Offset(1, 0) = Cel.Offset(0, 4).Value
    
     Else
     End If

Next Cel2
Next Cel

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[Marc L]

Hi,​

​

my first advice for huge data is to never use Excel as it is very not as fast as any database software !​

​

Looping cell by cell is the slowest way !​

So often an easy & faster way is to just use Excel basics like filter, formula, whatever …​

You can loop on arrays variables rather than on cell, this way could be the fastest​

but here the far slowest operation is your Sheet3 allocating cell by cell …​

​

An attachment with the before state and the expected result may help to find out a better way.​

 

[diddi]

if you are trying to get matches where cel = cel2 then sorting both arrays will help heaps because it provides an exit point in your search. it cam also provide an entry point.
another method is to index the array which cuts search time. even just reading the range as an array will make a speed improvement

 

[mumps]

Try this approach:

Sub Peteor()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim v1 As Variant, v2 As Variant, i As Long
    v1 = Sheets("Sheet1").Range("B2:B10").Resize(, 5).Value
    v2 = Sheets("Sheet2").Range("C2:C10").Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v2, 1)
            If Not .Exists(v2(i, 1)) Then
                .Add v2(i, 1), Nothing
            End If
        Next i
        For i = 1 To UBound(v1, 1)
            If .Exists(v1(i, 1)) Then
                Sheets("Sheet3").Range("F" & Rows.Count).End(xlUp).Offset(1, 0) = v1(i, 5)
            End If
        Next i
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

[Fluff]

For something like that I'd use arrays & a dictionary, like

Sub Peteor()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
Dim i As Long

Ary1 = Worksheets("Sheet1").Range("B2:F10000").Value2
Ary2 = Worksheets("Sheet2").Range("C2:C10000").Value2
ReDim Nary(1 To UBound(Ary1), 1 To 1)

With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Ary2)
      .Item(Ary2(i, 1)) = Empty
   Next i
   For i = 1 To UBound(Ary1)
      If .Exists(Ary1(i, 1)) Then
         nr = nr + 1
         Nary(nr, 1) = Ary1(R, 4)
      End If
   Next i
End With
Worksheets("Sheet3").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(nr).Value = Nary

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

 

[Peteor]

For something like that I'd use arrays & a dictionary, like

Sub Peteor()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim Ary1 As Variant, Ary2 As Variant, Nary As Variant
Dim i As Long

Ary1 = Worksheets("Sheet1").Range("B2:F10000").Value2
Ary2 = Worksheets("Sheet2").Range("C2:C10000").Value2
ReDim Nary(1 To UBound(Ary1), 1 To 1)

With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Ary2)
      .Item(Ary2(i, 1)) = Empty
   Next i
   For i = 1 To UBound(Ary1)
      If .Exists(Ary1(i, 1)) Then
         nr = nr + 1
         Nary(nr, 1) = Ary1(R, 4)
      End If
   Next i
End With
Worksheets("Sheet3").Range("F" & Rows.Count).End(xlUp).Offset(1, 0).Resize(nr).Value = Nary

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Thank you Fluff, and everyone for your replies! This one is what I will be looking into for this project. You guys are always super helpful! Thanks again!

 

[Fluff]

Glad we could help & thanks for the feedback.