Convert Vlookup to VBA

[barim]

Hello,
I have this code below and I am trying to convert Vlookup function into VBA. I have a little database called “MyDatabase" in a separate workbook, first sheet. My lookup starts comparison of column “B” from “WorkingFile” to “MyDatabase” of column “B”. Position of these columns is fixed, so there is no need to make them dynamic. Once there is a match, corresponding value in column “E” (Offset(0,3) from “MyDatabase” file should be copied to corresponding column “E” (Offset(0,3) in destination file which is “WorkingFile”. I've got stucked inside for loops. Error message points to this line: c1.Offset(0, 3).Value = c2.Offset(0, 3).Value. How do I test this data and once when it is matched I transfer it to another workbook?

Sub MyLookup()
    'Define variables
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim lrow1 As Variant
    Dim lrow2 As Variant
    Dim c1 As Variant
    Dim c2 As Variant
    
    'Define workbooks
    Set wb1 = Workbooks.Open("MyDatabase.xlsx")
    Set wb2 = Workbooks.Open("WorkingFile.xlsx")
     
    'Define last row of each column in each workbook for vlookup
    lrow1 = wb1.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
    lrow2 = wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
    
    'Loop through column B of MyDatabase and test if there is anything matching with column B in WorkingFile
    'Once found value in MyDatabase copy value from 3rd column to 3rd column on WorkingFile
        
    For c1 = 2 To lrow1
        For c2 = 2 To lrow2
                If c1.Value = c2.Value Then
                    c1.Offset(0, 3).Value = c2.Offset(0, 3).Value
                    
                    Exit For
                    
                    End If
                Next c2
                    
                Next c1
            
    
End Sub

[Leith Ross]

Hello barim,

Here are 2 macros based on your's that use different methods to get the same result.

Fully Qualified References

Sub MyLookup_1() 
'Define variables
Dim wb1 As Workbook 
Dim wb2 As Workbook 
Dim lrow1 As Long 
Dim lrow2 As Long 
Dim c1 As Long 
Dim c2 As Long 
'Define workbooks
Set wb1 = Workbooks.Open("MyDatabase.xlsx") 
Set wb2 = Workbooks.Open("WorkingFile.xlsx") 
'Define last row of each column in each workbook for vlookup
lrow1 = wb1.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row 
lrow2 = wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row 
'Loop through column B of MyDatabase and test if there is anything matching with column B in WorkingFile
'Once found value in MyDatabase copy value from 3rd column to 3rd column on WorkingFile
For c1 = 2 To lrow1 
For c2 = 2 To lrow2 
If wb1.Cells(c1, "B").Value = wb2.Cells(c2, "B").Value Then 
wb1.Cells(c1, "B").Offset(0, 3).Value = wb2.Cells(c2, "B").Offset(0, 3).Value 
Exit For 
End If 
Next c2 
Next c1 
End Sub

Shortcut Using Defined Ranges in Each Workbook

Sub MyLookup_2() 
'Define variables
Dim wb1 As Workbook 
Dim wb2 As Workbook 
Dim lrow1 As Long 
Dim lrow2 As Long 
Dim c1 As Range
Dim c2 As Range
Dim rng1 As Range
Dim rng2 As Range
'Define workbooks
Set wb1 = Workbooks.Open("MyDatabase.xlsx") 
Set wb2 = Workbooks.Open("WorkingFile.xlsx") 
'Define last row of each column in each workbook for vlookup
lrow1 = wb1.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row 
lrow2 = wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row
'Define the single column ranges to compare
Set rng1 = wb1.Range("B2:B" & lrow1)
Set rng2 = wb2.Range("B2:B" & lrow2) 
'Loop through column B of MyDatabase and test if there is anything matching with column B in WorkingFile
'Once found value in MyDatabase copy value from 3rd column to 3rd column on WorkingFile
'Loop the cells in each range, compare, and copy whe matched
For Each c1 In rng1 
For Each c2 in rng2 
If c1.Value = c2.Value Then 
c1.Offset(0, 3).Value = c2.Offset(0, 3).Value 
Exit For 
End If 
Next c2 
Next c1 
End Sub

[barim]

Leith Ross, thank you so much for your help. When I ran MyLookup_1 I encountered "Run-time error message 438: Object doesn't support this property or method". Debug pointed to this line:

If wb1.Cells(c1, "B").Value = wb2.Cells(c2, "B").Value Then

I fixed it by adding .Sheets(1) after each .Cells, and this fixed this problem. Same thing was with MyLookup_2.

Now, code executes without any error messages, but it doesn't pull any data from MyDatabase. For example, I have number 139892 in WorkingFile, Column B, and it should find this number in MyDatabase Column B, once when it finds this value it should go 3 columns over and pull corresponding value and print it to the 3rd column in WorkingFile. Same as Vlookup does, so if I work with Vlookup I would place formula in column E, WorkingFile and drag down until there is no more data.

Thanks again for this great help.

[Leith Ross]

Hello barim,

Is "MyDatabase" a worksheet in the workbook with the macro or a separate Excel workbook?

[barim]

"My Database" is a separate Excel workbook. "WorkingFile" is also separate workbook.
Thanks.

[Leith Ross]

Hello barim,

Something is definitely off. It would help if I could see all three workbooks. Would it possible for you to post them?

[barim]

Here are both files. Actually, there are only two files and not three. I highlighted in yellow columns that contain lookup data, and green is alternate id that I need it to be copied over once when criteria matched.
Thanks again for you help.

WorkingFile.xlsxMyDatabase.xlsx

[Leith Ross]

Hello barim,

Thanks for posting the workbooks. It was huge help.

I have written and tested both of the solutions shown. One uses more advanced VBA code and the other very simple code. It provides a good contrast in what you can do with VBA.

What is really interesting about the two, is the simpler version is the slowest.

Robust VBA Solution

Sub MyLookup_1()


    ' The House of Brick.
    ' More advanced code, very fast, and handles errors.
    
    ' Define variables
    Dim AltId       As Variant
    Dim wb1         As Workbook
    Dim wb2         As Workbook
    Dim lrow1       As Long
    Dim lrow2       As Long
    Dim c1          As Range
    Dim c2          As Range
    Dim Rng1        As Range
    Dim Rng2        As Range
    Dim VendorIDs   As Object
    


        ' Assign the workbook variables and open the workbooks if needed
        On Error Resume Next
            Set wb1 = Workbooks("MyDatabase.xlsx")
            If Err = 9 Then
                Set wb1 = Workbooks("MyDatabase.xlsx")
                Err.Clear
            ElseIf Err <> 0 Then
                GoTo ErrorHandler
            End If
            
            Set wb2 = Workbooks("WorkingFile.xlsx")
            If Err = 9 Then
                Set wb2 = Workbooks("WorkingFile.xlsx")
                Err.Clear
            ElseIf Err <> 0 Then
                GoTo ErrorHandler
            End If
        On Error GoTo 0
        
        ' Find the last row for each column "B" in both worksheets
        lrow1 = wb1.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
            ' Check for Vendor ID numbers
            If lrow1 < 2 Then
                MsgBox "Database Vendor ID column is empty.", vbExclamation
                Exit Sub
            End If
            
        lrow2 = wb2.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
            ' Check for Vendor ID numbers
            If lrow2 < 2 Then
                MsgBox "Working File Vendor ID column is empty", vbExclamation
                Exit Sub
            End If
        
        ' Assign the column "B" ranges to object variables
        Set Rng1 = wb1.Sheets(1).Range("B2:B" & lrow1)
        Set Rng2 = wb2.Sheets(1).Range("B2:B" & lrow2)
        
        ' Create an associative array
        Set VendorIDs = CreateObject("Scripting.Dictionary")
            VendorIDs.CompareMode = vbTextCompare
        
            ' Copy the unique Vendor IDs and Alternate IDs into the associative array
            For Each c1 In Rng1
                AltId = c1.Offset(0, 3)
                If c1.Value <> "" Then
                    If VendorIDs.Exists(c1.Value) = False Then
                        VendorIDs.Add c1.Value, AltId
                    End If
                End If
            Next c1
        
        ' Check if the Vendor IDs in the Working File exist in the Database
        For Each c2 In Rng2
            If VendorIDs.Exists(c2.Value) = True Then
                ' Copy the Alternate ID to the Working File
                c2.Offset(0, 3).Value = VendorIDs(c2.Value)
            End If
        Next c2
        
ErrorHandler:
        If Err <> 0 Then
            MsgBox "Run-time error " & "'" & Err.Number & "':" _
                    & vbLf & vbLf & Err.Description, vbOKOnly, "Macro - MyLookup_1"
        Else
            MsgBox "Copying of Alternate IDs Complete."
            Rng2.Parent.Activate
            Range("B2").Select
        End If
                    
End Sub

Simple VBA Solution

Sub MyLookup_2()
    
    ' The House of Straw.
    ' Simple code that works. But slow and does not handle errors.
    
    ' Define variables
    Dim wb1     As Workbook
    Dim wb2     As Workbook
    Dim lrow1   As Long
    Dim lrow2   As Long
    Dim c1      As Range
    Dim c2      As Range
    


        ' Assign the workbook variables and open the workbooks if needed
        Set wb1 = Workbooks("MyDatabase.xlsx")
        Set wb2 = Workbooks("WorkingFile.xlsx")
        
        ' Find the last row for each column "B" in both worksheets
        lrow1 = wb1.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
        lrow2 = wb2.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
        
        ' Loop through column B of MyDatabase and test if there is anything matching with column B in WorkingFile
        ' Once found value in MyDatabase copy value from 3rd column to 3rd column on WorkingFile
        For Each c1 In wb1.Sheets(1).Range("B2:B" & lrow1)
            For Each c2 In wb2.Sheets(1).Range("B2:B" & lrow2)
                If c1.Value = c2.Value Then
                    c2.Offset(0, 3).Value = c1.Offset(0, 3).Value
                    Exit For
                End If
            Next c2
        Next c1


End Sub

[barim]

Sir, you are the master of these codes. This is awesome! Actually, the shorter version works faster on my machine.

I am just trying to analyze the fix (shorter version):
Dim c1 and c2 you declared them as Range and previously they were Long.
For Each loop worked better than For loop.
It makes sense that inside for loops we give full paths to cells that we need to loop through.

Thank you so much for these answers. I learned a lot from this.

[Leith Ross]

Hello barim,

The For ... Each loop iterates through an array element by element and with Ranges cell by cell. That's why I changed c1 an c2 from long to a Range.

In VBA you are dealing with Objects and not formulae. Objects typically have Properties and Methods. Occasionally, they will also have Events. Learning to use objects is absolutely necessary to take full advantage of VBA.

[Paul_Hossler]

Couple of additional ideas

I liked Leith's dictionary approach since it will be faster when there are significant amounts of data

It appears that on Working more than just one field will be populated so I stored the row as Range object in the dictionary

I did make a few tweaks because of just my personal style (self documenting variable names, column numbers stored a constants, stuff like that)

I've found that it's a lot easier if I do that when I have to add or fix something in 6 months, as well as for someone else when I hand it off

Option Explicit
Sub MyLookup_2()
     
    Const DB_FacilityNameCol As Long = 1
    Const DB_VendorIDCol As Long = 2
    Const DB_VendorNameCol As Long = 3
    Const DB_ItemNumberCol As Long = 4
    Const DB_AlternateVendorIDCol As Long = 5
    Const DB_AlternateVendorNameCol As Long = 6
    Const DB_CommentsCol As Long = 7
     
    Const W_VendorNameCol As Long = 1
    Const W_VendorNumberCol As Long = 2
    Const W_ReorderNumberCol As Long = 3
    Const W_MfrVendorNameCol As Long = 4
    Const W_MfrVendorNumberCol As Long = 5
    Const W_MfrCatalogNumberCol As Long = 6
    Const W_Description1Col As Long = 7
    Const W_Description2Col As Long = 8

    ' Define variables
    Dim wbDatabase As Workbook
    Dim wbWorking As Workbook
    Dim lLastRowWithData As Long
    Dim rngCell As Range
    Dim rngVendorsList As Range
    Dim rngVendorsWorking As Range
    Dim VendorIDs As Object
     
     
     ' Assign the workbook variables and open the workbooks if needed
    On Error Resume Next
    Set wbDatabase = Workbooks("MyDatabase.xlsx")
    If Err = 9 Then
        Set wbDatabase = Workbooks("MyDatabase.xlsx")
        Err.Clear
    ElseIf Err <> 0 Then
        GoTo ErrorHandler
    End If
     
    Set wbWorking = Workbooks("WorkingFile.xlsx")
    If Err = 9 Then
        Set wbWorking = Workbooks("WorkingFile.xlsx")
        Err.Clear
    ElseIf Err <> 0 Then
        GoTo ErrorHandler
    End If
    On Error GoTo 0
     
     ' Find the last row for each column "B" in both worksheets and put in range
    With wbDatabase.Sheets(1)
        lLastRowWithData = .Cells(.Rows.Count, DB_VendorIDCol).End(xlUp).Row
        ' Check for Vendor ID numbers
        If lLastRowWithData < 2 Then
            MsgBox "Database Vendor ID column is empty.", vbExclamation
            Exit Sub
        End If
        Set rngVendorsList = .Cells(2, DB_VendorIDCol).Resize(lLastRowWithData - 1, 1)
    End With
     
    With wbWorking.Sheets(1)
        lLastRowWithData = .Cells(.Rows.Count, W_VendorNumberCol).End(xlUp).Row
         ' Check for Vendor ID numbers
        If lLastRowWithData < 2 Then
            MsgBox "Working File Vendor ID column is empty", vbExclamation
            Exit Sub
        End If
        Set rngVendorsWorking = .Cells(2, W_VendorNumberCol).Resize(lLastRowWithData - 1, 1)
    End With
     
     ' Create an associative array
    Set VendorIDs = CreateObject("Scripting.Dictionary")
    VendorIDs.CompareMode = vbTextCompare
     
     ' Copy the unique Vendor IDs and row into the associative array
    For Each rngCell In rngVendorsList
        With rngCell
            If Len(.Value) <> 0 Then
                If Not VendorIDs.Exists(.Value) Then
                    VendorIDs.Add .Value, .EntireRow
                End If
            End If
        End With
    Next rngCell
     
     ' Check if the Vendor IDs in the Working File exist in the Database
    For Each rngCell In rngVendorsWorking
        With rngCell
            If VendorIDs.Exists(rngCell.Value) Then
                .EntireRow.Cells(W_MfrVendorNumberCol).Value = VendorIDs(.Value).Cells(DB_AlternateVendorIDCol).Value
                .EntireRow.Cells(W_VendorNameCol).Value = VendorIDs(.Value).Cells(DB_VendorNameCol).Value
            End If
        End With
    Next rngCell
     
    MsgBox "Copying of Alternate IDs Complete."
    wbWorking.Activate
     
    Exit Sub
     
ErrorHandler:
    MsgBox "Run-time error " & "'" & Err.Number & "':" _
    & vbLf & vbLf & Err.Description, vbOKOnly, "Macro - MyLookup_2"
End Sub

[barim]

Leith and Paul,

Thank you so much for these codes. These long ones I need to study closely and figure out what each line stands for.

You are both true gurus.

[barim]

I am revisiting this thread since I have issue with duplicates. I am using simple VBA solution that Leith Ross suggested. The below code I changed slightly, since I need to just flip these values in place, instead of copying them to the 3^rd column. Also, E column contains lookup values. What I did here, I changed Offset value from (0,3) to (0,0). I repeated these loops, one for B column and one for E column and everything works fine until I encounter duplicate values. These lookups return only the first occurrence and it ignores the rest of them. I am attaching my workbooks for you to easily understand this. I randomly copied duplicate numbers through column B and column E. I would really like to use this simple version if possible. Thank you in advance.

Sub MyLookup_1()
      ' Define variables
    Dim wb1     As Workbook
    Dim wb2     As Workbook
    Dim lrow1   As Long
    Dim lrow2   As Long
    Dim c1      As Range
    Dim c2      As Range
   
    Application.ScreenUpdating = False ' This line will speed up macro execution
        
     ' Assign the workbook variables and open the workbooks if needed
    Set wb1 = Workbooks.Open("MyDatabase.xlsx")
    Set wb2 = Workbooks.Open("WorkingFile.xlsx")
    
     ' Find the last row for each column "B" in both worksheets
    lrow1 = wb1.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    lrow2 = wb2.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    
     ' Loop through column B of MyDatabase and test if there is anything matching with column B in Item Add
     ' Once found value in WorkingFile copy value from 3rd column to 3rd column on Item Add
     
    For Each c1 In wb1.Sheets(1).Range("B2:B" & lrow1)
        For Each c2 In wb2.Sheets(1).Range("B2:B" & lrow2)
            If c1.Value = c2.Value Then
                c2.Offset(0, 0).Value = c1.Offset(0, 3).Value
                Exit For
            End If
        Next c2
    Next c1
   
    For Each c1 In wb1.Sheets(1).Range("B2:B" & lrow1)
        For Each c2 In wb2.Sheets(1).Range("E2:E" & lrow2)
            If c1.Value = c2.Value Then
                c2.Offset(0, 0).Value = c1.Offset(0, 3).Value
                Exit For
            End If
        Next c2
    Next c1

[barim]

I think I solved this myself. I just deleted "Exit For" statement from both loops and now it is picking up all duplicate values. If anybody has better solution please let me know.
Thanks.

[Leith Ross]

Hello barim,

Good work. I was checking your new files for modifications when I received an email from VBAX. I don't think you will get simpler code to do the job.

In the future, if your data set becomes large then you may need to use a different method for speed and efficiency.

[barim]

Thank you Leith. I don't expect to have really huge files, but if macro becomes really slow, I will have to look for some other solutions. So far, I haven't tested it with real data, but I hope it will serve the purpose. Thank you again for all your help!

[Leith Ross]

Hello Barim,

You're welcome. Keep me updated on your progress.

[barim]

Leith Ross or Paul, or anybody who could help me with this.
I know it's been awhile, but I ran into one issue. These lookups are meant for data that is formatted as number. I have text only codes in column E. For example, ABCD and it should be replaced with let's say 4567834. I tried to run this but it is not working on data formatted as text.
These are codes that I am using to run data. It works for numbers. What do I need to change in order to work for text?

Sub MyLookup_1() 
     ' Define variables
    Dim wb1     As Workbook 
    Dim wb2     As Workbook 
    Dim lrow1   As Long 
    Dim lrow2   As Long 
    Dim c1      As Range 
    Dim c2      As Range 
     
    Application.ScreenUpdating = False ' This line will speed up macro execution
     
     ' Assign the workbook variables and open the workbooks if needed
    Set wb1 = Workbooks.Open("MyDatabase.xlsx") 
    Set wb2 = Workbooks.Open("WorkingFile.xlsx") 
     
     ' Find the last row for each column "B" in both worksheets
    lrow1 = wb1.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row 
    lrow2 = wb2.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row 
     
     ' Loop through column B of MyDatabase and test if there is anything matching with column B in Item Add
     ' Once found value in WorkingFile copy value from 3rd column to 3rd column on Item Add
     
    For Each c1 In wb1.Sheets(1).Range("B2:B" & lrow1) 
        For Each c2 In wb2.Sheets(1).Range("B2:B" & lrow2) 
            If c1.Value = c2.Value Then 
                c2.Offset(0, 0).Value = c1.Offset(0, 3).Value 
                Exit For 
            End If 
        Next c2 
    Next c1 
     
    For Each c1 In wb1.Sheets(1).Range("B2:B" & lrow1) 
        For Each c2 In wb2.Sheets(1).Range("E2:E" & lrow2) 
            If c1.Value = c2.Value Then 
                c2.Offset(0, 0).Value = c1.Offset(0, 3).Value 
                Exit For 
            End If 
        Next c2 
    Next c1

[Leith Ross]

Hello Barim,

It would help to see the updated versions of your workbooks. Can you post copies of them?

[snb]

Sub M_snb()
   sn= workbooks("MyDatabase.xlsx").sheets(1).usedrange.columns(2)
   sp= workbooks("Workingfile.xlsx").sheets(1).usedrange.columns(2).resize(,3)
   
   for j=1 to ubound(sn)
     if sn(j,1)<>"" then
       for jj=1 to ubound(sp)
         if sn(j,1)=sn(jj,1) then exit for
       next
       if jj<=ubound(sp) then sn(j,1)=sp(jj,3)
     end if
  next

  workbooks("MyDatabase.xlsx").sheets(1).usedrange.columns(2)=sn