Complex Referencing for Macro Solution???

[DougK73]

Hello:

I have a material list in Excel that has unique part numbers listed vertically (one for every cell in the column) - no duplicates - (list "A"). In another list - seperate tab - (list "B"), I have the same part numbers listed vertically but they are repeating; for every part number listed, there is a unique quantity listed vertically in the next column over - one unique quantity number listed next to every repeated part number. Consequently, I want to identify the part number listed in list "A" and bring into list "A" all of the associated quantites for that particular part number from list "B". The quantities would be listed horizontally next to the unique part number in the column. Please see below:

List "A" (Sheet 1)

Part number
111.2222.333
222.3333.444
555.6666.777

List "B" (Sheet 2)

Part number Quantities
111.2222.333 1,000
111.2222.333 2,000
111.2222.333 3,000
222.3333.444 1,500
222.3333.444 2,100
555.6666.777 25
555.6666.777 150
555.6666.777 200

RESULT
List "A" (Sheet 1) - Result!

Part number Quantities (each in a different cell listed horizontally)
111.2222.333 1,000 2,000 3,000
222.3333.444 1,500 2,100
555.6666.777 25 150 200

The range in each list ("A" and "B") will vary depending upon the length of each downloaded list into Excel. Consequently, the macro needs to be adjustable for values in arrays; I'm assuming.

What is the macro code to do this?

Any help is greatly appreciated.

 

[shg]

One way:

Sub Doug()
    Dim rInp        As Range
    Dim rOut        As Range
    Dim nCol        As Long
    Dim vRow        As Variant
    Dim cell        As Range
 
    With Worksheets("Sheet2")
        Set rInp = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    End With
 
    Set rOut = Worksheets("Sheet1").Columns("A")
    nCol = Worksheets("Sheet1").Columns.Count
 
    For Each cell In rInp
        vRow = Application.Match(cell.Value2, rOut, 0)
        If IsError(vRow) Then
            MsgBox "Part " & cell.Value & " not found!"
        Else
            rOut.Cells(vRow, nCol).End(xlToLeft).Offset(, 1).Value = cell.Offset(, 1).Value2
        End If
    Next cell
End Sub

 

[DougK73]

When I run this, I get an error on every part number. How do I fix this?

Thanks,
Doug

 

[shg]

I don't know. The code assumes the part numbers are in col A of Sheet1 and Sheet2.

 

[DougK73]

Hello:

I found my problem. I have so many part numbers that I actually do not care if a match is not successful. Conseqently, I "commented" your message box notification that pauses the matching for every unsuccessful match. This way, the marco runs through the "sheet1" list of matches without stopping.

I really need to learn how to program in VBA!

It now works fine. Thank you for your help; I greatly appreciate it.

Thanks,
-Doug K.

 

[shg]

You're welcome, Doug, good luck.