PDA

View Full Version : Convert Vlookup to VBA



barim
12-27-2016, 01:21 PM
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
12-27-2016, 07:01 PM
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
12-28-2016, 08:50 AM
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
12-28-2016, 10:08 AM
Hello barim,

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

barim
12-28-2016, 10:29 AM
"My Database" is a separate Excel workbook. "WorkingFile" is also separate workbook.
Thanks.

Leith Ross
12-28-2016, 10:37 AM
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
12-28-2016, 11:11 AM
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.

1791417915

Leith Ross
12-28-2016, 06:51 PM
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
12-29-2016, 08:37 AM
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
12-29-2016, 09:30 AM
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
12-29-2016, 09:51 AM
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
12-30-2016, 07:38 AM
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.:bow:

barim
01-09-2017, 08:33 AM
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 3rd 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
01-09-2017, 11:52 AM
:cool: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
01-09-2017, 02:22 PM
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
01-11-2017, 10:32 AM
:thumbThank 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
01-11-2017, 11:04 AM
Hello Barim,

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

barim
04-18-2017, 06:08 PM
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
04-19-2017, 09:13 AM
Hello Barim,

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

snb
04-19-2017, 11:30 AM
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

barim
04-19-2017, 06:22 PM
Leith Ross, thank you so much for your response.

As you can see in My Database, now I have text values that represent Vendor code, it is not only number values like it was before.

In Working File lookup values that contain text values are in column E, those should be flipped by number values from My Database found in column E. I think that both columns(B and E) in Working File that should be flipped with number values from My Database will be mixed with text and number values, so it could happen vendor code as let's say 33448877 and next line could be AADDUUOO.

I need something that should ignore formatting and treat these as lookup values regardless if it is text or number.
Let me know if you need more information.

Thank you Leith Ross again. :friends:

1897318972

snb
04-20-2017, 12:10 AM
Try the suggestion in #20

barim
05-18-2017, 10:37 AM
I am trying to make this work. In the Working File I highlighted columns in yellow that need to be flipped with other values.

From Database1 I am having text values as a lookup criteria. They are highlighted in yellow and and values from column highlighted in green should be pulled into Working File and replaced.

From Database2 Column highlighted in yellow should be looked up and green values should be placed in Working File.

To summarize, Column C from Working File should be flipped by values highlighted in green from Database1. Column F from Working File should be flipped by values highlighted in green from Database2.

The trick here is that both columns from Working File are formatted as text although column F looks like number.

I appreciate any help on this.