Need a way to make the loop faster in Excel VBA - excel

Question

I work for a construction company. I have been writing a macro for the inventory department which can retrieve the latest date on which a particular type of material was supplied to a specific Flat No. at site.
The code which I have is doing the job but it's taking very long to compute all the results. Can anyone tell me how to make this go even faster.
Following is the code:
Sub FillTopSheet()
'Designing a loop to move through the fill data on Top Sheet
Application.ScreenUpdating = False
'Declaring variables for counts
Dim Flat_Row_Num As Long
Dim Tower_Col_Num As Long
Dim InventoryWs As Worksheet
'Debug.Print Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out").Name
Set InventoryWs = Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out")
Dim Lookup_Start_Row As Long
Dim Lookup_End_Row As Long
'Lookup_Start_Row = 4
'
'Select Case Application.ThisWorkbook.ActiveSheet.Name
' Case "Kitchen Carcass"
' Do Until InventoryWs.Cells(Lookup_Start_Row, 2).Value = "Kitchen Carcass"
' Lookup_Start_Row = Lookup_Start_Row + 1
' Loop
'
' Lookup_End_Row = Lookup_Start_Row
'
' Do While InventoryWs.Cells(Lookup_End_Row, 2).Value = "Kitchen Carcass"
' Lookup_End_Row = Lookup_End_Row + 1
'
' Loop
'
' Lookup_End_Row = Lookup_End_Row - 1
'
'End Select
Debug.Print Lookup_Start_Row
Debug.Print Lookup_End_Row
Lookup_Start_Row = 6162
Lookup_End_Row = 14754
Flat_Row_Num = 5
Tower_Col_Num = 5
Do Until Tower_Col_Num > 13
Do Until Flat_Row_Num > 154
If Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num - 1).Value <> "" Then
Do Until Lookup_Start_Row = Lookup_End_Row
If Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num - 1).Value = _
InventoryWs.Cells(Lookup_Start_Row, 8).Value Then
Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num).Value = _
InventoryWs.Cells(Lookup_Start_Row, 6).Value
GoTo RowReset
Else
Application.ThisWorkbook.ActiveSheet.Cells(Flat_Row_Num, Tower_Col_Num).Value = "NA"
End If
Lookup_Start_Row = Lookup_Start_Row + 1
Loop
Lookup_Start_Row = 6162
RowReset:
Lookup_Start_Row = 6162
End If
Flat_Row_Num = Flat_Row_Num + 1
Loop
Flat_Row_Num = 5
Tower_Col_Num = Tower_Col_Num + 2
Loop
Application.ScreenUpdating = True
End Sub

Answer 1

Could be something like this but indexes (i,j,k) might be mixed up.
Would be much easier if you could post your input and desired output (eg some screenshot)
Sub FillTopSheet()
'Declaring variables for counts
Dim Flat_Row_Num As Long
Dim Tower_Col_Num As Long
Dim InventoryWs As Worksheet, Ws As Worksheet
Dim ArrLookUp() As Variant, ArrData() As Variant
Dim Lookup_Start_Row As Long, Lookup_End_Row As Long, i As Long, j As Long, k As Long
Dim FlatNo As String
'Designing a loop to move through the fill data on Top Sheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Debug.Print Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out").Name
Set InventoryWs = Application.Workbooks("The Crest DLF Project-In-Out Inventory Data.xlsx").Worksheets("Material-Out")
Debug.Print Lookup_Start_Row
Debug.Print Lookup_End_Row
Lookup_Start_Row = 6162
Lookup_End_Row = 14754
Flat_Row_Num = 5
Tower_Col_Num = 2 'Start in Tower A "Flats No. column
With InventoryWs
ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8))
End With
With Ws
ArrData = .Range(.Cells(Flat_Row_Num, Tower_Col_Num), .Cells(154, 13))
End With
For i = LBound(ArrData, 2) To UBound(ArrData, 2) Step 2
For j = LBound(ArrData) To UBound(ArrData)
'loop through "towers" Array
FlatNo = ArrData(j, i) 'take one flat no
If FlatNo <> "" Then
For k = LBound(ArrLookUp) To UBound(ArrLookUp)
'look for this flat no in other array
If FlatNo = ArrLookUp(k, 3) Then
'first match = take Date from other array
'dates sorted descending
ArrData(j, i + 1) = ArrLookUp(k, 1)
'found what was looking for, get out of loop
Exit For
End If
Next k
End If
Next j
Next i
With Ws
'range must be same as when you set the array earlier. But if that range contains some formulas they'll be overwriten with values
'in that case you can loop through array and take out only dates
.Range(.Cells(Flat_Row_Num, Tower_Col_Num), .Cells(154, 13)) = ArrData
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Edit
This still might need some adjustment to fit in your ranges
Check ranges in ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8)) and ArrLookUp = .Range(.Cells(Lookup_Start_Row, 6), .Cells(Lookup_End_Row, 8))
It takes "Towers" and looks for "Flats No." in other sheet. At first match date is taken from other sheet.