PDA

View Full Version : VBA OR VLOOKUP METHOD HELP?



JoeDogs
07-18-2017, 03:53 AM
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
07-18-2017, 04:53 AM
Can you post a sample workbook demonstrating what you are after. Go Advanced/Manage Attachments

JoeDogs
07-18-2017, 06:03 AM
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
07-18-2017, 09:24 AM
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
07-18-2017, 10:48 AM
Doesnt seem to be working :(

mdmackillop
07-18-2017, 11:22 AM
See attached sample

JoeDogs
07-18-2017, 11:50 AM
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
07-18-2017, 12:17 PM
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