• 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.

VBA Vlookup Help

D

Dokat

Member
Hi,

I have below vlookup code however when i ran it doesnt return any value? Can anyone help me with the issue. I dont receive any error messages. Thanks

Sub Lookup()

Dim vResults As Range
Set vResults = ActiveSheet.Range("b2:b32")
Dim LookupValue As Range
Set LookupValue = ActiveSheet.Range("A2:A32")
Dim LookupRange As Range
Set LookupRange = ActiveSheet.Range("O2:p33")
LookupColNum = 2
ExactMatch = False
For Each LookupValue In ActiveSheet.UsedRange

vResults = Application.WorksheetFunction.VLookup(LookupValue, LookupRange, LookupColNum, ExactMatch)
End Sub
Click to expand...
 
Thank you for sending the link

I modified the code but getting Run Time error 457 This key is already associated with an element of this collection error. What cause this problem?

below cose is highlighted in yellow
Code: 
Call vlookupCol.Add(CStr(categories(i)), values(i))



Code: 
Sub LookupVBA()
    OptimizeVBA True
    Dim startTime As Single, endTime As Single
    startTime = Timer
  
    Dim Brand As Range, Tier As Range
    Dim lookupBrand As Range, lookupTier As Range
    Dim vlookupCol As Object
  
    Set Brand = Worksheets("Sheet1").Range("O:O")
    Set Tier = Worksheets("Sheet1").Range("P:P")
    Set lookupBrand = Worksheets("Sheet1").Range("a:a")
    Set lookupTier = Worksheets("Sheet1").Range("B:B")
  
    'Build Collection
    Set vlookupCol = BuildLookupCollection(Brand, Tier)
  
    'Lookup the values
    VLookupValues lookupBrand, lookupTier, vlookupCol
    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
        Call vlookupCol.Add(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
 
So you have duplicate in categories. It should be unique list.

If you need to handle duplicate, you need different logic than simple VLookup.
 
No i dont have duplicate categories. To be honest not sure what you mean with duplicate categories. I am trying to lookup brand in column A:A in Column "O P" and return the value to column B. Attached is the screenshot.
 

Attachments

  • Untitled.png
    Untitled.png
    170.9 KB · Views: 6
In the code, "CStr(categories(i))" is used as Key for dictionary. Dictionary requires this to be unique.

If you step through the code, you should see that you are trying to add Key string that's already in use.

I'd recommend uploading small sample file with expected output. So it's easier for us to see what you are trying to accomplish.
 
Why is there blank rows? From the looks of it, it's not serving any purpose.
Get rid of it if you don't need it. That's what's causing the code to error out.
 
In the actual file there are over 300K rows and there are blanks due to incomplete data. Is there workaround this. Also i tested the sample file with no blankls and this time its giving me error 457 this key is already associated with an element of this collection error message.
 
I'm guessing since you used entire column in lookup range. That's causing issue.

First of all... test with.
Code: 
    Set Brand = Worksheets("Sheet1").Range("O2:O32")
    Set Tier = Worksheets("Sheet1").Range("P2:P32")
    Set lookupBrand = Worksheets("Sheet1").Range("a2:a32")
    Set LookupTier = Worksheets("Sheet1").Range("B2:B32")

Or you can make it dynamic like below.
Code: 
    With Worksheets("Sheet1")
        Set Brand = .Range("O2:O" & .Cells(Rows.Count, "O").End(xlUp).Row)
        Set Tier = .Range("P2:P" & .Cells(Rows.Count, "P").End(xlUp).Row)
        Set lookupBrand = .Range("a2:a" & .Cells(Rows.Count, "A").End(xlUp).Row)
        Set LookupTier = .Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row)
    End With

And add if statement to exclude blanks.
Code: 
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
        If categories(i) <> "" Then
            Call vlookupCol.Add(CStr(categories(i)), values(i))
        End If
    Next i
   
    Set BuildLookupCollection = vlookupCol
End Function
 
Hi,

I modified the code however vlookup returning Blank value. Essentially i'd like it to lookup value in "Summary" sheet column D:D, vlookup Lookup Table column A:B and return the corresponding value in Column B to Summary sheet column C:C. I couldnt figure out why its returning blank value.
Appreciate any help.

Code: 
Sub VlookupVba()
    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 - BIC\BIC\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, 1).End(xlUp).Row
    flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row
    Set pSKU = sWs.Range("B4:B" & slRow)
    Set lupSKU = fWs.Range("D4:D" & flRow)
    For i = 2 To 2
        Set outputCol = fWs.Range(fWs.Cells(3, i), fWs.Cells(flRow, i))
        Select Case i
            Case 2
                Set luVal = sWs.Range("B4: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



Chihiro said:
I'm guessing since you used entire column in lookup range. That's causing issue.

First of all... test with.
Code: 
    Set Brand = Worksheets("Sheet1").Range("O2:O32")
    Set Tier = Worksheets("Sheet1").Range("P2:P32")
    Set lookupBrand = Worksheets("Sheet1").Range("a2:a32")
    Set LookupTier = Worksheets("Sheet1").Range("B2:B32")

Or you can make it dynamic like below.
Code: 
    With Worksheets("Sheet1")
        Set Brand = .Range("O2:O" & .Cells(Rows.Count, "O").End(xlUp).Row)
        Set Tier = .Range("P2:P" & .Cells(Rows.Count, "P").End(xlUp).Row)
        Set lookupBrand = .Range("a2:a" & .Cells(Rows.Count, "A").End(xlUp).Row)
        Set LookupTier = .Range("B2:B" & .Cells(Rows.Count, "A").End(xlUp).Row)
    End With

And add if statement to exclude blanks.
Code: 
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
        If categories(i) <> "" Then
            Call vlookupCol.Add(CStr(categories(i)), values(i))
        End If
    Next i

    Set BuildLookupCollection = vlookupCol
End Function
Click to expand...
 
Please disregard, modified the code and its working now.

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 - BIC\BIC\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("B4: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



Dokat said:
Hi,

I modified the code however vlookup returning Blank value. Essentially i'd like it to lookup value in "Summary" sheet column D:D, vlookup Lookup Table column A:B and return the corresponding value in Column B to Summary sheet column C:C. I couldnt figure out why its returning blank value.
Appreciate any help.

Code: 
Sub VlookupVba()
    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 - BIC\BIC\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, 1).End(xlUp).Row
    flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row
    Set pSKU = sWs.Range("B4:B" & slRow)
    Set lupSKU = fWs.Range("D4:D" & flRow)
    For i = 2 To 2
        Set outputCol = fWs.Range(fWs.Cells(3, i), fWs.Cells(flRow, i))
        Select Case i
            Case 2
                Set luVal = sWs.Range("B4: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
Click to expand...
 
Dokat
This is second time within one week someone else had to do Your duties.
Please reread Forum Rules - those are for You too.

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...
chandoo.org
  • Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.
  • If you do cross-post, please put that in your post.
  • Also if you have cross-posted and get an Solution elsewhere, have the courtesy of posting the Solution here so other readers can learn from the answer also, as well as stopping people wasting their time on your answered question.
 
You must log in or register to reply here.
Back
Top