• Status: Solved
• Priority: Medium
• Security: Public
• Views: 188

# Lookup tables - Excel, macro

Sub LookUp()

Dim rListOne As Range
Dim rListTwo As Range
Dim iColDiff As Integer

On Error Resume Next
Windows("Microcell Materials (20 January 2003).xls").Activate
Set rListOne = Range("A:A,B:B")

If rListOne Is Nothing Then End

Windows("ICEE - STR 7129.xls").Activate
Set rListTwo = Range("A:A,G:G")

If rListTwo Is Nothing Then End

rListTwo.Offset(0, 6).FormulaR1C1 = "=VLOOKUP(RC[-1]," & rListOne.Address(ReferenceStyle:=xlR1C1) & " ,6,FALSE)"

rListTwo.Offset(0, 6) = rListTwo.Offset(0, 6).Value

Set rListOne = Nothing
Set rListTwo = Nothing

On Error GoTo 0

End Sub

I want to match the text / values in column A in one spreadsheet with the same text / values in columns A on the lookup spreadsheet, and return the text / value from column B and paste it in column G on the original spreadsheet.

Help!!
0
zoeg
• 3
• 2
1 Solution

Commented:
I think you need something along these lines

Dim rRowListOne As Range
Dim rRowListTwo As Range

For Each rRowListOne In rListOne.Rows
For Each rRowListTwo In rListTwo.Rows
If rRowListOne.Cells(1, 1).Value = rRowListTwo.Cells(1, 1).Value Then
rRowListOne.Cells(1, 7).Value = rRowListTwo.Cells(1, 2).Value
Exit For
End If
Next rCellListTwo
Next rCellListOne
0

Commented:
Excel already has a built in function to do this called "VLOOKUP"... Here is how to use it..

In your original spreadsheet, paste this formula in column G (you might have to modify the book and sheet names.. and the range.. but if you paste what I have, you can use the f* button to bring up the function wizard for easy modification etc...

=VLOOKUP(A1,[ICEE - STR 7129]Sheet1!\$A\$1:\$B\$26,2,FALSE)
0

Author Commented:
Microcell Materials (20 January 2003).xls

This is the file with all of the info init, the lookup table. In columns A and B

ICEE - STR 7129.xls

This is the file where the data is needed. In column G.

So match cols A and A in both and paste data in col B into col G.

Microcell Materials (20 January 2003).xls
Col A - B
James     10
Smith     50
Rashpal     20
John     100
Billy     180
Fred     260
Mary     340
Carol     420
Richard     500
Joseph     580
Anne     660
Carol J     740
Vera     820
Harry     900
Marion     980
Mary W     1060

ICEE - STR 7129.xls
Col A - G
Anne
Billy
Carol
Carol J
Fred
Harry
James
John
Joseph
Marion
Mary
Mary W
Rashpal
Richard
Smith
Vera
0

Author Commented:
Microcell Materials (20 January 2003).xls

This is the file with all of the info init, the lookup table. In columns A and B

ICEE - STR 7129.xls

This is the file where the data is needed. In column G.

So match cols A and A in both and paste data in col B into col G.

Microcell Materials (20 January 2003).xls
Col A - B
James     10
Smith     50
Rashpal     20
John     100
Billy     180
Fred     260
Mary     340
Carol     420
Richard     500
Joseph     580
Anne     660
Carol J     740
Vera     820
Harry     900
Marion     980
Mary W     1060

ICEE - STR 7129.xls
Col A - G
Anne
Billy
Carol
Carol J
Fred
Harry
James
John
Joseph
Marion
Mary
Mary W
Rashpal
Richard
Smith
Vera
0

Author Commented:
Example;

=VLOOKUP(A24,'[Microcell Materials (20 January 2003).xls]Sheet1'!\$A:\$B,2,FALSE)

This need to be done in a macro not as a formula.
0

Commented:
Okay, here is a macro that will do it for you... just set the variables for the ranges and return column appropriately.

Public Sub myLookup()
Dim rSource As Range
Dim rDest As Range
Dim rLookupRange As Range
Dim lReturnCol As Long

Set rSource = Range("'[ICEE - STR 7129.xls]Sheet1'!A1:A50")
Set rDest = Range("'[ICEE - STR 7129.xls]Sheet1'!G1:G50")
Set rLookupRange = Range("'[Microcell Materials (20 January 2003).xls]Sheet1'!\$A:\$B")
lReturnCol = 2

If rSource.Columns.Count > 1 Or rDest.Columns.Count > 1 Then
MsgBox "Source or Dest ranges can only be 1 column.", vbInformation
Exit Sub
End If

If rSource.Rows.Count <> rDest.Rows.Count Then
MsgBox "Source and Dest ranges do not have the same amount of rows.", vbInformation
Exit Sub
End If

If lReturnCol > rLookupRange.Columns.Count Then
MsgBox "Return column must be within the Lookup Range specified.", vbInformation
Exit Sub
End If

Dim x As Long
Dim rFind As Range

For x = 1 To rSource.Rows.Count
Set rFind = rLookupRange.Find(rSource.Cells(x, 1))
If Not rFind Is Nothing Then
rDest.Cells(x, 1) = rFind.Cells(1, lReturnCol)
End If
Set rFind = Nothing
Next x

End Sub

0

## Featured Post

• 3
• 2
Tackle projects and never again get stuck behind a technical roadblock.