VLookup VBA

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

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
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
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
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
 

chrisjack

New member
Joined
Oct 22, 2012
Messages
15
Reaction score
0
Points
0
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 ()"
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
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:

chrisjack

New member
Joined
Oct 22, 2012
Messages
15
Reaction score
0
Points
0
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
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
Sure, but you can just add a line that will more than likely make that unnecessary.

See here.

Good Luck with your project.
 
Top