Hi,
I have below vlookup code but it only returns the first value in the lookup table and doesnt return the remaining lookup values. What's causing this issue? Anybody came across the same issue?
I have below vlookup code but it only returns the first value in the lookup table and doesnt return the remaining lookup values. What's causing this issue? Anybody came across the same issue?
Code:
Sub VlookupVV()
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("G:\USNSH_DG\Reports\Segmentation\Value Valley Segmentation.xlsx")
Set sWs = sWb.Sheets("Segmentation")
Set fWs = ThisWorkbook.Sheets("Summary")
slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row
flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row
Set pSKU = sWs.Range("A2:A" & slRow)
Set lupSKU = fWs.Range("V2:V" & flRow)
For i = 20 To 20
Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
Select Case i
Case 20
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