• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Vlookup Code doesnt return all values

Dokat

Member
I have below vba vlookupcode that supposed to return values in Column A, B and C. When i run the code it doesn't give me an error message however only returns the lookup value for Column C. Can someone help me understand why it doesnt return lookup values for Column A and B? Thanks

Code:
Option Explicit
Sub UpdateValues()
    OptimizeVBA True
    Dim startTime As Single, endTime As Single
    startTime = Timer
    Dim fWs As Worksheet, sWs As Worksheet
    Dim slRow As Long, flRow As Long
    Dim pSKU As Range, pSKU2 As Range
    Dim pSKU3 As Range, luVal As Range
    Dim lupSKU As Range, lupSKU2 As Range
    Dim lupSKU3 As Range, outputCol As Range
    Dim vlookupCol As Object
    Dim i As Long
    Set sWs = ThisWorkbook.Sheets("Source Data")
    Set fWs = ThisWorkbook.Sheets("Source Data")
    slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row
    flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row
    Set pSKU = sWs.Range("P2:P" & slRow)
    Set lupSKU = fWs.Range("A2:A" & flRow)
    Set pSKU2 = sWs.Range("R2:R" & slRow)
    Set lupSKU2 = fWs.Range("B2:B" & flRow)
    Set pSKU3 = sWs.Range("U2:U" & slRow)
    Set lupSKU3 = fWs.Range("C2:C" & flRow)
     
    i = 1
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
           
            Set luVal = sWs.Range("Q2:Q" & slRow)
    i = 2
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
           
            Set luVal = sWs.Range("S2:S" & slRow)
    i = 3
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
           
            Set luVal = sWs.Range("V2:V" & 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
    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
 
because is this block
Code:
 i = 1
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
            Set luVal = sWs.Range("Q2:Q" & slRow)
    i = 2
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
            Set luVal = sWs.Range("S2:S" & slRow)
    i = 3
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
            Set luVal = sWs.Range("V2:V" & slRow)

you just reset your lookups for columns 1 and 2. Before calling
Code:
Set vlookupCol = BuildLookupCollection(pSKU, luVal)
Hence only the last "set" will be used to performed the lookup.

You could try this
Code:
For i = 1 To 3
   j = 17 'column number for Q
   Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
   Set luVal = sWs.Range(cells(2,j),cells(  slRow,j))
   Set vlookupCol = BuildLookupCollection(pSKU, luVal)
   VLookupValues lupSKU, outputCol, vlookupCol
j=j+2
next i
 
Can you upload a sample file?
I suspect part of your code is in the wrong place. Personally I cannot visualize how code is running without having some data. Real developers can though.
If you run your script step by step (F8), you normally see where your macro starts going wrong. And you can debug from there.
 
Please see attached. I am trying to get value from Column A,B,C to automatically update once i copy paste a new values. I also have Worksheet Change Event
 

Attachments

  • Ad Tracker Q4-17 w Summary Table v9.0.xlsm
    715.4 KB · Views: 3
I created individual vlookups rater than compiling all in one vba code. It's not ideal and I am sure there is better way to do it in VBA.

I also added Worksheet Change Event Handler on the source data tab...and call each macro...it worked.
 
Getting it to work is step one, so well done.
I'm leaving the optimization to the genuine vba specialists here. Some code you are using is also new to me. But your uploaded file will help others, help you better.
 
Back
Top