Search code examples
vbaexcelobjectdefined

VBA Vlookup across multiple sheets


So I have two lists, each one in a different sheet. I'm checking that values in Sheet B are also in Sheet A. I'm using VLookup for this, the problem seems to be with the range statements, as this range appears to be 'empty'.

My VBA attempt is something like,

Dim lookupVal As String
Dim myString As String

For i = 1 to N
    lookupVal = Sheets("b").Cells(1 + i, 2)
    myString = Application.WorksheetFunction.VLookup(lookupVal, Sheets("a").range(Sheets("a").Cells(9,3), Sheets("a").Cells(N+8, 3)), 1, False)
    If IsEmpty(myString) Then
        Sheets("b").Cells(1+i, 3) = ""
    Else
        Sheets("b").Cells(1+i, 3) = myString
    End if

Next i

I get 'Run-time 1004: Application-defined or object-defined error'. Any help appreciated.


Solution

  • There are two problems in your code:

    1. for worksheetfunction.vlookup the searching range cant be volatile. So the way to solve this issue is to use additional variable to do it permanent

    2. if worksheetfunction.vlookup cannot find the searching value, then error will appear, in this case you need to use additional manipulation with error handling

    3. lookupVal must be declared as Range due to format of the cells (lookup range and lookup value) can be different, but in your code cells value always will be converted into string type, and you will not be able to find numbers if they converted into string

    4. myString also required to be declared as Variant due to same reason as described in "3." Type of the cell can be double for instance, but your code will convert it into string

    so, your updated code is below, works fine

    Sub test()
    Dim lookupVal As Range, myString As Variant, Rng$, n&
    n = Sheets("b").[B:B].Cells.Find("*", , , , xlByRows, xlPrevious).Row
    On Error Resume Next
    For i = 1 To n
        Set lookupVal = Sheets("b").Cells(1 + i, 2)
        Rng = Range(Cells(9, 3), Cells(n + 8, 3)).Address
        myString = WorksheetFunction.VLookup(lookupVal, Sheets("a").Range(Rng), 1, False)
        If Err.Number > 0 Then
            Sheets("b").Cells(1 + i, 3) = ""
            Err.Clear
        Else
            Sheets("b").Cells(1 + i, 3) = myString
        End If
    Next i
    End Sub
    

    alternative way below

    Sub test()
    Dim cl As Range, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary"): Dic.Comparemode = vbTextCompare
    With Sheets("a")
        For Each cl In .Range("C9:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
            If Not Dic.exists(cl.Value) Then Dic.Add cl.Value, cl.Row
        Next cl
    End With
    With Sheets("b")
        For Each cl In .Range("B2:B" & .Cells(Rows.Count, "B").End(xlUp).Row)
            If Dic.exists(cl.Value) Then cl.Offset(, 1).Value = cl.Value
        Next cl
    End With
    Set Dic = Nothing
    End Sub