Looping through range using VBA in Excel

Question

I have a block of code that takes way too long to process for some files. Smaller files (fewer lines of data) work fine, but once I get to about 150-300, it starts to get slow, (sometimes I think the whole process actually just hangs) and I have to run this sometimes on files with up to 6,000.

I want to plug in a VLookup() function in the .FormulaR1C1 for a number of cells. I know that I can set the whole range at once using .Range("J2:J" & MaxRow). However, I am looping through a block of cells to check the value of those cells. IF they are empty, THEN I want to apply the formula. If those cells already have values, then I don't want to change them, so I don't think the whole range option will work for me (at least I was unable to get it right).

Private Sub PullMIAFinalizedData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)

Dim wksFinalized As Worksheet
Dim lCount As Long
Dim sVLookupJBlock As String
Dim sVLookupKBlock As String

    Application.Calculation = xlCalculationManual

    sVLookupJBlock = "=IF(ISERROR(" & _
        "VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C13,13,FALSE))," & _
        Chr(34) & Chr(34) & _
        ",VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C13,13,FALSE))"
    sVLookupKBlock = "=IF(ISERROR(" & _
        "VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C3,3,FALSE))," & _
        Chr(34) & Chr(34) & _
        ",VLOOKUP(RC1,'[" & wkbFinalized.Name & "]" & wksFinalized.Name & "'!C1:C3,3,FALSE))"

    For Each wksFinalized In wkbFinalized.Sheets

        ShowAllRecords wksFinalized 'Custom Function to unhide/unfilter all data

        With NewMIARep

            For lCount = 2 To MaxRow

                If .Range("J" & lCount).value = "" And .Range("K" & lCount).value = "" Then
                    .Range("J" & lCount).FormulaR1C1 = sVLookupJBlock
                    .Range("K" & lCount).FormulaR1C1 = sVLookupKBlock

                    Application.Calculate

                    With .Range("J" & lCount & ":K" & lCount)
                        .value = .value
                    End With


                End If
            Next lCount

            .Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"

        End With

    Next wksFinalized

    Application.Calculation = xlCalculationAutomatic

End Sub

Am I just stuck with this?

Try it after removing Application.Calculate. Also have you considered using .Find instead of Vlookup (since you are converting them back to values?) See SECTION 4 in this link siddharthrout.wordpress.com/2011/07/14/… — Siddharth Rout
– Siddharth Rout, Commented Mar 15, 2012 at 17:35
Do you have to Calculate on each row? If not, change calculation to manual. You should also turn off screen updates: Application.ScreenUpdating = FALSE and don't forget to turn it back on after the loop. — mechanical_meat
– mechanical_meat, Commented Mar 15, 2012 at 17:38
I have posted the full code. I think I have to calculate each turn, because I am then taking the value and plugging it back in. (so as not to slow down the process calculating 6,000 VLookups simultaneously). Taking a look at your link now, @SiddharthRout... — Gaffi
– Gaffi, Commented Mar 15, 2012 at 17:48
@SiddharthRout That worked great! That will save me so much time in the future. I would love to accept this as an asnwer, if you wouln't mind adding it. — Gaffi
– Gaffi, Commented Mar 15, 2012 at 18:17

Community · Accepted Answer · 2017-05-23 10:25:24Z

Thanks very much to assylias and Siddharth Rout for helping out with this; both provided very useful information, which led to this result:

Private Sub PullMIAFinalizedData(NewMIARep As Worksheet, MaxRow As Long, wkbFinalized As Workbook)

Dim wksFinalized As Worksheet
Dim lCount As Long
Dim lFinMaxRow As Long
Dim DataRange As Variant 'per assylias, using a variant array to run through cells
Dim FoundRange As Range
    Application.Calculation = xlCalculationManual
    With NewMIARep
        DataRange = .Range("J2:K" & MaxRow)
        For Each wksFinalized In wkbFinalized.Sheets
            ShowAllRecords wksFinalized
            lFinMaxRow = GetMaxRow(wksFinalized)
            If lFinMaxRow > 1 Then
                For lCount = 1 To MaxRow - 1
                    If Len(DataRange(lCount, 1)) = 0 And Len(DataRange(lCount, 2)) = 0 Then
                        'per Siddharth Rout, using Find instead of VLookup
                        Set FoundRange = wksFinalized.Range("A2:A" & lFinMaxRow).Find(What:=.Range("A" & lCount).value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                        If Not FoundRange Is Nothing Then
                            DataRange(lCount, 1) = FoundRange.Offset(ColumnOffset:=12).value
                            DataRange(lCount, 2) = FoundRange.Offset(ColumnOffset:=2).value
                            Set FoundRange = Nothing
                        End If
                    End If
                Next lCount           
            End If
        Next wksFinalized
    .Range("J2:K" & MaxRow).value = DataRange
    .Range("J2:J" & MaxRow).NumberFormat = "mm/dd/yyyy"
    End With

    Application.Calculation = xlCalculationAutomatic

End Sub

assylias · Accepted Answer · 2012-03-15 17:37:51Z

2

You don't want to iterate on cells from VBA: it is EXTREMELY slow. Instead, you put the data you need into an array, work on the array and put the data back to the sheet. In your case, something like the code below (not tested):

Dim data as Variant
Dim result as Variant
Dim i as Long
data = ActiveSheet.UsedRange

ReDim result(1 To UBound(data,1), 1 To UBound(data,2)) As Variant

For i = LBound(data,1) to UBound(data,1)
    'do something here, for example
    If data(i,1) = "" Then
        result(i,1) = "=VLOOKUP($A1,$A:$G," & i & ",FALSE)"
    Else
        result(i,1) = data(i,1)
    End If
Next i

ActiveSheet.Cells(1,1).Resize(Ubound(result, 1), UBound(result,2)) = result

answered Mar 15, 2012 at 17:37

assylias

330k84 gold badges680 silver badges806 bronze badges

4 Comments

Gaffi Over a year ago

This was helpful, but did not create an increase in speed quite as much as @Sid's response. If he does not supply an answer, I will accept this. Thanks!

assylias Over a year ago

If his answer was better you should either accept it if he posts it or post the answer yourself and accept it.

Gaffi Over a year ago

Well, it's a combination of both. His just improved my process more (based on one test).

Gaffi Over a year ago

@SiddharthRout I will in 2 days, when SO allows me to. ;-) Thanks again to both of you!

Collectives™ on Stack Overflow

Looping through range using VBA in Excel

2 Answers 2

Comments

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related