VBA Help - For Each Loop with Large Data Set - Need an Alternative Loop

[Johnny Thunder]

Hello everyone,

I am working on a project that will at some point get migrated into an actual database but at the moment is being managed in excel and the data has gotten really large. The Row count of the report has now hit over 300k+ across 12 columns. Unfortunately there is no way to trim off old data so I am stuck with this report as is.

Need:
I have a macro that loops thru one column and looks for a specific "Type" and if found revises one column value with another value and if it finds anything other than a specific "Type" if will also process a revision. Currently, the only way that seems to work for me with my limited knowledge of large loops is a For Each statement but I am hoping someone can think of a better/faster way to do this that went get an 'Overflow' error due to the high data set.

Code currently takes 8min to run so hoping to get that time down to under a minute if possible. Any help is appreciated.

*I am also doing this on a mac version of excel which does not have the ActiveX module active or allow for creating libraries but most all other codes work without issues.

Here is the current code:

Sub AlterDownload()

Dim ws1         As Worksheet, ws2 As Worksheet
Dim LastR1     As String, LastR2 As Long
Dim Count      As String
Dim ceLL        As Range
Dim r               As Long

Set ws1 = Sheets("Download")
Set ws2 = Sheets("Lookup")

LastR1 = ws1.Range("F" & Rows.Count).End(xlUp).Row
LastR2 = ws2.Range("B" & Rows.Count).End(xlUp).Row

For Each ceLL In ws1.Range("G2:G" & LastR1)
    r = ceLL.Row
        If ceLL.Value = "EpisodeVersion" Then
                ws1.Range("P" & r).Value = ws1.Range("C" & r).Value
        Else
            ws1.Range("P" & r).Value = ws1.Range("A" & r).Value
        End If
Next ceLL


End sub

 

[johnnyL]

Ok, I put this code together with the idea to use an array to speed things up. You also have included some code that is not used in the subroutine that you posted, so I commented those lines out. I also included some other lines that, when you are dealing with large amounts of data, they can speed things up also.

I have not tried this code, so let us know how it works out for you. It should work, at least in my head:

Sub AlterDownload()
'
    Dim gRowCounter     As Long                                     ' Added
    Dim LastR1          As Long                                     ' Added
''    Dim r               As Long                                     ' Replaced, No longer needed
''    Dim LastR2          As Long                                     ' Not used in this subroutine
''    Dim ceLL            As Range                                    ' Replaced, No longer needed
''    Dim Count           As String                                   ' Don't do that, it is a reserved word
''    Dim LastR1          As String                                   ' This should be 'As Long'
    Dim gColumnArray()  As Variant                                  ' Added
    Dim ws1             As Worksheet
''    Dim ws2             As Worksheet                                ' Not used in this subroutine
'
'
    Application.ScreenUpdating = False                              ' Added
    Application.Calculation = xlCalculationManual                   ' Added
    Application.EnableEvents = False                                ' Added
'
    Set ws1 = Sheets("Download")
''    Set ws2 = Sheets("Lookup")                                      ' Not used in this subroutine
'
    LastR1 = ws1.Range("F" & Rows.Count).End(xlUp).Row
''    LastR2 = ws2.Range("B" & Rows.Count).End(xlUp).Row             ' Not used in this subroutine
'
'---------------------------------------------------------------------------------------------------
''    For Each ceLL In ws1.Range("G2:G" & LastR1)                   ' Code section that is slow
''        r = ceLL.Row
'
''        If ceLL.Value = "EpisodeVersion" Then
''            ws1.Range("P" & r).Value = ws1.Range("C" & r).Value
''        Else
''            ws1.Range("P" & r).Value = ws1.Range("A" & r).Value
''        End If
''    Next ceLL
'---------------------------------------------------------------------------------------------------
'
    gColumnArray = ws1.Range("G2:G" & LastR1).Value                 ' This will load values into a one based array ;) ie. gColumnArray(1,1) gColumnArray(2,1)
'
    For gRowCounter = 1 To UBound(gColumnArray)
        If gColumnArray(gRowCounter, 1) = "EpisodeVersion" Then                                 ' Check G2,G3,G4, etc for "EpisodeVersion", If Found then
            ws1.Range("P" & gRowCounter + 1).Value = ws1.Range("C" & gRowCounter + 1).Value     '   Set P2,P3,P4, etc to value found in C2,C3,C4, etc
        Else                                                                                    ' Else
            ws1.Range("P" & gRowCounter + 1).Value = ws1.Range("A" & gRowCounter + 1).Value     '   Set P2,P3,P4, etc to value found in A2,A3,A4, etc
        End If
    Next
'
    Application.EnableEvents = True                                 ' Added
    Application.Calculation = xlCalculationAutomatic                ' Added
    Application.ScreenUpdating = True                               ' Added
End Sub

Code without all of the lines that I commented out = :

Sub AlterDownload()
'
    Dim gRowCounter     As Long                                     ' Added
    Dim LastR1          As Long                                     ' Added
    Dim gColumnArray()  As Variant                                  ' Added
    Dim ws1             As Worksheet
'
'
    Application.ScreenUpdating = False                              ' Added
    Application.Calculation = xlCalculationManual                   ' Added
    Application.EnableEvents = False                                ' Added
'
    Set ws1 = Sheets("Download")
'
    LastR1 = ws1.Range("F" & Rows.Count).End(xlUp).Row
'
    gColumnArray = ws1.Range("G2:G" & LastR1).Value                 ' This will load values into a one based array ;) ie. gColumnArray(1,1) gColumnArray(2,1)
'
    For gRowCounter = 1 To UBound(gColumnArray)
        If gColumnArray(gRowCounter, 1) = "EpisodeVersion" Then                                 ' Check G2,G3,G4, etc for "EpisodeVersion", If Found then
            ws1.Range("P" & gRowCounter + 1).Value = ws1.Range("C" & gRowCounter + 1).Value     '   Set P2,P3,P4, etc to value found in C2,C3,C4, etc
        Else                                                                                    ' Else
            ws1.Range("P" & gRowCounter + 1).Value = ws1.Range("A" & gRowCounter + 1).Value     '   Set P2,P3,P4, etc to value found in A2,A3,A4, etc
        End If
    Next
'
    Application.EnableEvents = True                                 ' Added
    Application.Calculation = xlCalculationAutomatic                ' Added
    Application.ScreenUpdating = True                               ' Added
End Sub

 

[Akuini]

@Johnny Thunder
Not sure why have 'Set ws2 = Sheets("Lookup")' but you don't use it.
Try this (I didn't test it because I have no data to test):

Sub a1178366a()
'https://www.mrexcel.com/board/threads/vba-help-for-each-loop-with-large-data-set-need-an-alternative-loop.1178366/
Dim ws1         As Worksheet, ws2 As Worksheet
Dim LastR1     As String, LastR2 As Long
Dim Count      As String
Dim ceLL        As Range
Dim r               As Long
Dim VA, VC, VG, VP

Set ws1 = Sheets("Download")
'Set ws2 = Sheets("Lookup")

LastR1 = ws1.Range("F" & Rows.Count).End(xlUp).Row
'LastR2 = ws2.Range("B" & Rows.Count).End(xlUp).Row

VP = ws1.Range("P2:P" & LastR1)
VA = ws1.Range("A2:A" & LastR1)
VC = ws1.Range("C2:C" & LastR1)
VG = ws1.Range("G2:G" & LastR1)

For i = 1 To UBound(VG, 1)
    If VG(i, 1) = "EpisodeVersion" Then
        VP(i, 1) = VC(i, 1)
    Else
        VP(i, 1) = VA(i, 1)
    End If
Next


ws1.Range("P2").Resize(UBound(VP, 1), 1) = VP

End Sub

 

[Fluff]

Another option, no loops

Sub johnnyThunder()
With Sheets("Download")
   With .Range("P2:P" & .Range("F" & Rows.Count).End(xlUp).Row)
      .Value = .Worksheet.Evaluate("if(" & .Offset(, -9).Address & "=""EpisodeVersion""," & .Offset(, -13).Address & "," & .Offset(, -15).Address & ")")
   End With
End With
End Sub

 

[Johnny Thunder]

Thank you everyone for all the help on this! Several great ideas!

 

[Fluff]

Glad we could help & thanks for the feedback.