Hi,
I have VBA Code that should look up 1,116 rows of data in "Summary" sheet and return corresponding value from Lookup table column B to Summary Sheet (Column C). However when i ran the code it only looks and returns value for the first 62 rows. It should be looking for 1,116 rows, What may cause this issue? Appreciate any help
I have VBA Code that should look up 1,116 rows of data in "Summary" sheet and return corresponding value from Lookup table column B to Summary Sheet (Column C). However when i ran the code it only looks and returns value for the first 62 rows. It should be looking for 1,116 rows, What may cause this issue? Appreciate any help
VBA Code:
Sub Vlookup()
OptimizeVBA True
Dim startTime As Single, endTime As Single
startTime = Timer
Dim sWb As Workbook
Dim fWs As Worksheet, sWs As Worksheet
Dim slRow As Long, flRow As Long
Dim pSKU As Range, luVal As Range
Dim lupSKU As Range, outputCol As Range
Dim vlookupCol As Object
Set sWb = Workbooks.Open("C:\Users\dokat\OneDrive - \Power BI\Trade Report\Montly Data\Segment Lookup Table.xlsx")
Set sWs = sWb.Sheets("Lookup")
Set fWs = ThisWorkbook.Sheets("Summary")
slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row
flRow = fWs.Cells(Rows.Count, 1).End(xlUp).Row
Set pSKU = sWs.Range("A2:A" & slRow)
Set lupSKU = fWs.Range("D4:D" & flRow)
For i = 2 To 2
Set outputCol = fWs.Range(fWs.Cells(4, i + 1), fWs.Cells(flRow, i + 1))
Select Case i
Case 2
Set luVal = sWs.Range("B2:B" & slRow)
End Select
'Build Collection
Set vlookupCol = BuildLookupCollection(pSKU, luVal)
'Lookup the values
VLookupValues lupSKU, outputCol, vlookupCol
Next i
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False
sWb.Close False
Set vlookupCol = Nothing
End Sub
Function BuildLookupCollection(categories As Range, values As Range)
Dim vlookupCol As Object, i As Long
Set vlookupCol = CreateObject("Scripting.Dictionary")
For i = 1 To categories.Rows.Count
vlookupCol.Item(CStr(categories(i))) = values(i)
Next i
Set BuildLookupCollection = vlookupCol
End Function
Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
Dim i As Long, resArr() As Variant
ReDim resArr(lookupCategory.Rows.Count, 1)
For i = 1 To lookupCategory.Rows.Count
resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
Next i
lookupValues = resArr
End Sub
Sub OptimizeVBA(isOn As Boolean)
Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
Application.EnableEvents = Not (isOn)
Application.ScreenUpdating = Not (isOn)
ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub
