Concat Rows if Column A matches

[loract]

I'm working with an order report that lists every item on an order on a new line. I need to mail merge to a summary report that will have all the items on one sheet of paper. I've set up this macro to merge all the Item Numbers, Item Names, and Quantities ordered all onto one row, deleting the rows once they've been merged. It is working pretty well so far BUT if columns 15 (which is "O"), Row 4 happens to be the same quantity as O5, it deletes the first quantity. The same thing happens in Column N. No other duplicate in those columns have been deleted - just the first row (which is row 4). Column M, which is the item number of the ordered product, does not have the same issue. Even if the first two rows have the same item number, they are both retained. It's only happening for the first two rows of N and O that are causing the problem. Columns M, N, and O are the ones that I need to retail all the info. "A" is the only other column that has data in every row of the report. The other columns only have data in the initial row for each contract. Hope that makes sense. It looks something like this:

CONTRACT RESERVATION DATE ,etc until row M ITEMNUM ITEMNAME QTY
517027 176704 4/28/23 2745 Yellow Shirt 4
517027 5478 Blue Shirt 4
517027 7458 Green Hat 5
547512 178562 4/29/23 8745 Frosted Cake 1
547512 4756 Boiled Egg 6


This is the code I am working with. I did not write this - I copied after googling how to achieve my outcome and stumbled around personalizing it until I got it to (mostly) work.
Can you help me figure out how to stop deleting the first two duplicates?
Any help would be appreciated!

Sub Pulling Report ()
Dim myRow As Long
    Dim sTRef As String
    sTRef = Cells(2, "a")
    myRow = 4
    Do While Cells(myRow, "a") <> ""
        If sTRef <> Cells(myRow, "a") Then
            sTRef = Cells(myRow, "a")
            myRow = myRow + 1
        Else
            For i = 1 To 16
                If Cells(myRow - 1, i) = "" Then
                    Cells(myRow - 1, i) = Cells(myRow, i)
                Else
                        If Cells(myRow, i) = Cells(myRow - 1, i) Then
                            Cells(myRow - 1, i) = Cells(myRow, i)
                        Else
                            If Cells(myRow, i) <> "" Then
                                Cells(myRow - 1, i) = Cells(myRow - 1, i) & vbNewLine & Cells(myRow, i)
                            End If
                        End If
                End If
            Next i
            rows(myRow).Delete Shift:=xlUp
        End If
        Loop
rows(1).EntireRow.Delete
    rows(2).EntireRow.Delete
    Range("A1").Value = "CONTRACT"
    Range("b1").Value = "RESERVATION"
    Range("C1").Value = "OUTDATE"
    Range("D1").Value = "INDATE"
    Range("E1").Value = "NAME"
    Range("F1").Value = "JOBNAME"
    Range("G1").Value = "ADDY1"
    Range("H1").Value = "ADDY2"
    Range("I1").Value = "CITY"
    Range("J1").Value = "STATE"
    Range("K1").Value = "ZIP"
    Range("L1").Value = "POJOB"
    Range("P1").Value = "ITEMS"
End Sub

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I also suggest that you investigate XL2BB for providing sample data & expected results to make it easier for helpers to understand just what you have & where it is and also what you want & where it is to be. Also, we can more easily copy/paste your sample data to test with it.

When deleting rows, best to work from the bottom up, not top down.
Since I can't be quite sure what you have in what rows/columns, the code below might still need some more tweaking but give it a go and see if it is headed in the right direction.
Test with a copy of your data.

Sub PullingReport_v2()
  Dim myRow As Long, i As Long

  Application.ScreenUpdating = False
  For myRow = Range("A" & Rows.Count).End(xlUp).Row To 4 Step -1
    If Cells(myRow, "a").Value = Cells(myRow - 1, "a").Value Then
      For i = 2 To 16
        If Cells(myRow, i).Value <> "" Then
          If Cells(myRow - 1, i).Value = "" Then
            Cells(myRow - 1, i).Value = Cells(myRow, i).Value
          Else
            Cells(myRow - 1, i).Value = Cells(myRow - 1, i).Value & vbNewLine & Cells(myRow, i).Value
          End If
        End If
      Next i
      Rows(myRow).Delete
    End If
  Next myRow
  Rows(1).EntireRow.Delete
  Rows(2).EntireRow.Delete
  Range("A1:L1").Value = Array("CONTRACT", "RESERVATION", "OUTDATE", "INDATE", "NAME", "JOBNAME", "ADDY1", "ADDY2", "CITY", "STATE", "ZIP", "POJOB")
  Range("P1").Value = "ITEMS"
  Application.ScreenUpdating = True
End Sub

 

[loract]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I also suggest that you investigate XL2BB for providing sample data & expected results to make it easier for helpers to understand just what you have & where it is and also what you want & where it is to be. Also, we can more easily copy/paste your sample data to test with it.

When deleting rows, best to work from the bottom up, not top down.
Since I can't be quite sure what you have in what rows/columns, the code below might still need some more tweaking but give it a go and see if it is headed in the right direction.
Test with a copy of your data.

Sub PullingReport_v2()
  Dim myRow As Long, i As Long

  Application.ScreenUpdating = False
  For myRow = Range("A" & Rows.Count).End(xlUp).Row To 4 Step -1
    If Cells(myRow, "a").Value = Cells(myRow - 1, "a").Value Then
      For i = 2 To 16
        If Cells(myRow, i).Value <> "" Then
          If Cells(myRow - 1, i).Value = "" Then
            Cells(myRow - 1, i).Value = Cells(myRow, i).Value
          Else
            Cells(myRow - 1, i).Value = Cells(myRow - 1, i).Value & vbNewLine & Cells(myRow, i).Value
          End If
        End If
      Next i
      Rows(myRow).Delete
    End If
  Next myRow
  Rows(1).EntireRow.Delete
  Rows(2).EntireRow.Delete
  Range("A1:L1").Value = Array("CONTRACT", "RESERVATION", "OUTDATE", "INDATE", "NAME", "JOBNAME", "ADDY1", "ADDY2", "CITY", "STATE", "ZIP", "POJOB")
  Range("P1").Value = "ITEMS"
  Application.ScreenUpdating = True
End Sub

Thank you so much! It's working perfectly now!

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.