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?

Answer 1

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