Hi,
I use below VBA code to do vlookup between 2 workbooks. However code doesnt return all the corresponding values...it is odd that it worked without any problem before and for some reason it only returns partial results....basically only returns the corresponding value for first lookup item. I wonder if anyone come across similar issue and have a solve for it. Thanks
I use below VBA code to do vlookup between 2 workbooks. However code doesnt return all the corresponding values...it is odd that it worked without any problem before and for some reason it only returns partial results....basically only returns the corresponding value for first lookup item. I wonder if anyone come across similar issue and have a solve for it. Thanks
Code:
Sub DivisionVlookup()
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\DG Fiscal Calender.xlsx")
Set sWs = sWb.Sheets("Sheet2")
Set fWs = ThisWorkbook.Sheets("Append")
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("b2:b" & flRow)
For i = 23 To 23
Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
Select Case i
Case 23
Set luVal = sWs.Range("c2:c" & 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