VLookup VBA

C

chrisjack

New member
Joined
Oct 22, 2012
Messages
15
Reaction score
0
Points
0
I have an excel workbook that has sheet1 & sheet2.
Sheet1 has 11 columns. Columns A through K. The Name of the field in column A is “Material” which is numeric with 8 numbers.
Sheet2 has 18 columns. Columns A through R. Column B on this sheet is also called “Material” which is numeric with 8 numbers.
My goal is to create a macro, when executed will go through all the cells in column B regardless of how many (Loop) on sheet2 and vlookup sheet1 column A to see if there is an EXACT match. If it finds an Exact match, it will copy the value of that entire row on sheet1 from columns B through K and paste special in the matching “Material” row in sheet2 from columns “S” through “AC”. Columns S through K has the same name fields as columns B through K on sheet1. If a material number in sheet2 does not match any in sheet1, “NA” is populated in all the fields S through AC of that “Material” number on sheet2. How can I accomplish this task. Thanks in advance for your help.


I have attached excel file. My macro does not accomplish all I want it to do when executed.
It doesn’t populate column “AC” in sheet2
It doesn’t populate “NA” in columns S through AC to “Material” numbers on sheet2 that don’t exist in sheet1
I would like the macro to stop running when it gets to the last record on sheet2. The number of records varies. It is sometimes less than 100, sometimes in the 100’s or 1000’s.

Once again thanks for your help
 

Attachments

  • WorkingCopy.xlsm
    55 KB · Views: 29
Hello chrisjack

I would use the MATCH function.
Something along the lines of this.

Code: 
Option Explicit

Sub GetSheet1Info()

    Dim Sh1LastRow As Long
    Dim Sh2LastRow As Long
    Dim Sh1Material As Range
    Dim Sh2Material As Range
    Dim cel As Range
    Dim MatchRow As Variant
    
'last row of material on sheet1
    Sh1LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
'last row of material on sheet2
    Sh2LastRow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
'range on sheet1 to deal with
    Set Sh1Material = Sheet1.Range("A1:A" & Sh1LastRow)
'range on sheet2 to deal with
    Set Sh2Material = Sheet2.Range("B2:B" & Sh2LastRow)

'step thru sheet2 material column and look for same material on sheet1
For Each cel In Sh2Material
    MatchRow = Application.Match(cel.Value, Sh1Material, 0)
    'if no match, MatchRow = Error 2042
        If IsError(MatchRow) Then
            Sheet2.Range("S" & cel.Row, "AB" & cel.Row).Value = "NA"
        Else
            Sheet1.Range("B" & MatchRow, "K" & MatchRow).Copy Destination:=cel.Offset(0, 17)
        End If
Next cel
    
End Sub
 
Noticed your sheet2 column X does not exist on sheet1 so slight revision to skip that column

Code: 
For Each cel In Sh2Material
    MatchRow = Application.Match(cel.Value, Sh1Material, 0)
    'if no match, MatchRow = Error 2042
        If IsError(MatchRow) Then
            Sheet2.Range("S" & cel.Row, "W" & cel.Row).Value = "NA"
            Sheet2.Range("Y" & cel.Row, "AC" & cel.Row).Value = "NA"
        Else
            Sheet1.Range("B" & MatchRow, "F" & MatchRow).Copy Destination:=cel.Offset(0, 17)
            Sheet1.Range("G" & MatchRow, "K" & MatchRow).Copy Destination:=cel.Offset(0, 23)
        End If
Next cel
 
Hi NoS,
Thanks for your help. I copied your code and pasted in a module. I get an error when I try to run it. It says "Compile error: Next without For". When I click OK it highlights "Sub GetSheetInfo ()"
 
Does what you pasted in look like this?
I have no problems running this on the file you provided.
I can upload your file with this if needed.

Code: 
Option Explicit

Sub GetSheet1Info()

    Dim Sh1LastRow As Long
    Dim Sh2LastRow As Long
    Dim Sh1Material As Range
    Dim Sh2Material As Range
    Dim cel As Range
    Dim MatchRow As Variant
    
'last row of material on sheet1
    Sh1LastRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
'last row of material on sheet2
    Sh2LastRow = Sheet2.Cells(Rows.Count, "B").End(xlUp).Row
'range on sheet1 to deal with
    Set Sh1Material = Sheet1.Range("A1:A" & Sh1LastRow)
'range on sheet2 to deal with
    Set Sh2Material = Sheet2.Range("B2:B" & Sh2LastRow)

'step thru sheet2 material column and look for same material on sheet1
For Each cel In Sh2Material
    MatchRow = Application.Match(cel.Value, Sh1Material, 0)
    'if no match, MatchRow = Error 2042
        If IsError(MatchRow) Then
            Sheet2.Range("S" & cel.Row, "W" & cel.Row).Value = "NA"
            Sheet2.Range("Y" & cel.Row, "AC" & cel.Row).Value = "NA"
        Else
            Sheet1.Range("B" & MatchRow, "F" & MatchRow).Copy Destination:=cel.Offset(0, 17)
            Sheet1.Range("G" & MatchRow, "K" & MatchRow).Copy Destination:=cel.Offset(0, 23)
        End If
Next cel
    
End Sub
 
Last edited:
Hi Acolyte,
It works really great. Can You add a code that will display a message saying "Script Running Please wait" and when its done it will display "Complete" and when you click the "OK" button the message will disappear. Thanks for all your help
 
Sure, but you can just add a line that will more than likely make that unnecessary.

See here.

Good Luck with your project.
 
You must log in or register to reply here.
Back
Top