Transposing and merging cells if certain criteria true

[Jeff M]

Attached is an example of the spreadsheet I am working with. The "address and vendor id example" tab shows what I need the macro to do.

Essentially I am looking for the macro to do the following:

1) If there is only one instance of the vendor name, leave the row as-is.
lines 4,5 and 6 from the example tab are examples of one instance of a supplier name, need to leave these rows as-is
lines 3, 4 and 12, 13 are 2 instances of the same supplier name, the macro will have to modify these lines

2) If there are 2 instances of the same supplier name with the same mailing address 1, I would like to combine those 2 lines into one. The macro will need to transpose the ID's horizontally and then merge into one cell with a comma and 2 spaces separating them.
lines 3, 4 and 26, 27 from the "example" tab are a good example of this

Also if there are 2 instances of the same supplier name and the mailing address 1 is filled in for one row but now the following row, I need to copy the address from above.

I know this is somewhat unclear but hopefully the examples i did in the "address and vendor id example" tab will help clarify.

I haven't come across a situation yet that this website hasn't solved. Thanks for all your help!

Jeff

[rylo]

Hi

see if this is a start.

Sub aaa()
  Sheets("address and vendor id").Activate
  Range("A:J").Sort key1:=Range("A1"), order1:=xlAscending, key2:=Range("B1"), order2:=xlAscending, header:=xlYes
  For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i - 1, 1) And IsEmpty(Cells(i, 2)) Then Cells(i, 2).Value = Cells(i - 1, 2).Value
  Next i
  
  Range("A1:J1").Copy Destination:=Range("L1")
  
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If WorksheetFunction.CountIf(Range(Range("A1"), Cells(i, 1)), Cells(i, 1).Value) = 1 Then
      Cells(i, 1).Resize(1, 10).Copy Destination:=Cells(i, "L")
    Else
      outrow = WorksheetFunction.Match(Cells(i, 1).Value, Range("A:A"), 0)
      Cells(outrow, "U").Value = Cells(outrow, "U").Value & ",  " & Cells(i, "J").Value
    End If
  
  Next i
End Sub

rylo