Looping through range using VBA in Excel - vba

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

Answer 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