VBA OR VLOOKUP METHOD HELP?

[JoeDogs]

Hi everyone,

i am am new to this forum and VBA or the VLOOKUP method and wondering if you could help me out.

I have 2 sections of data in 2 separate sheets and need to sort them. They each have cells filled from A1:Q300

From the data in the second sheet (A2), it references a product in the first sheet and I'd like to move all the data from the second sheet to be in line with the same product from the first sheet.

for example:
sheet1:
A1 to Q300 has data on different products (labelled by product #)

sheet 2:
A1 to P120 has additional data on the products mentioned in sheet1 (also labelled by most of the same numbers in sheet1)

i want to:
Sort the products in sheet2 to align with that corresponding product in sheet 1
so now sheet 1 would be A1 to Q300 + corresponding data from sheet 2
essentially want to combine the 2 sheets together but have the data organized by line for that product number

im sorry if this is confusing, it was hard to word and i am frustrated as I've been working on this on and off for a couple weeks now. Just can't seem to figure it out! Any help would be appreciated! Thanks

[mdmackillop]

Can you post a sample workbook demonstrating what you are after. Go Advanced/Manage Attachments

[JoeDogs]

Id like to take the information in sheet 2 and align it with its corresponding product number in sheet 1 so that all columns related to the one product number are in one workbook. Some products in sheet 2 are not there in sheet 1 either. Please send easy way to do this as I have over 600 products to sort through.

Sample attached.

If you could include the steps to doing this that would be great

[mdmackillop]

Sub Test()    Dim r As Range, cel As Range, tgt As Range
    Dim col As Long
    Dim sh As Worksheet


    Application.ScreenUpdating = False
    'Add new sheet & copy data from sheet1
    Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
    Sheet1.UsedRange.Copy sh.Cells(1, 1)
    'Find last column & copy first row
    col = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    Sheet2.UsedRange.Offset(, 1).Rows(1).Copy sh.Cells(1, col + 1)
    'Find Product in new sheets and copy data to end of row
    For Each cel In Sheet2.Columns(1).SpecialCells(2, 1)
        Set tgt = sh.Columns(1).Find(cel, lookat:=xlWhole).Offset(, col)
        cel.Offset(, 1).Resize(, 17).Copy tgt
    Next cel
    sh.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

[JoeDogs]

Doesnt seem to be working

[mdmackillop]

See attached sample

[JoeDogs]

Thank you! One problem I see is that it seems to give me an error if the product line in the second sheet has no match in sheet1 (this will be the case for a lot of products) is there a way to fix this?

I think it has something to do with:

For Each cel In Sheets("Sheet2").Columns(2).SpecialCells(2, 1)
Set tgt = sh.Columns(1).Find(cel, lookat:=xlWhole).Offset(, 22)


Because if I enter a value (e.g. find(23231, lookat...) in the second line instead of find(cel), it works with that product line.

[mdmackillop]

I understood Sheet 2 was a subset of Sheet 2.
This will append additional sheet 2 items underneath

Sub Test()    Dim r As Range, cel As Range, tgt As Range
    Dim col As Long
    Dim sh As Worksheet
     
     
    Application.ScreenUpdating = False
     'Add new sheet & copy data from sheet1
    Set sh = Sheets.Add(after:=Sheets(Sheets.Count))
    Sheet1.UsedRange.Copy sh.Cells(1, 1)
     'Find last column & copy first row
    col = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    Sheet2.UsedRange.Offset(, 1).Rows(1).Copy sh.Cells(1, col + 1)
     'Find Product in new sheets and copy data to end of row
    For Each cel In Sheet2.Columns(1).SpecialCells(2, 1)
        Set tgt = sh.Columns(1).Find(cel, lookat:=xlWhole)
        If Not tgt Is Nothing Then
            Set tgt = tgt.Offset(, col)
            cel.Offset(, 1).Resize(, 17).Copy tgt
        Else
            Set tgt = sh.Cells(Rows.Count, 1).End(xlUp)(2)
            tgt = cel
            cel.Offset(, 1).Resize(, 17).Copy tgt.Offset(, col)
        End If
    Next cel
    sh.Columns.AutoFit
    Application.ScreenUpdating = True
End Sub