Concatenate based on unique column combination.

Hi

I have minimal experience in writing macros in VBA, but was wondering if someone could please help me.

I have data extracted out of a finincial system where the long text firld is broken over many lines. Each unique combination in columns A, B, and C should have column D concatenated and the orginial lines deleted. I have 25,000 lines, and will do so each quarter.

I would really appreciate some help - I have tried to leverage off other solutions in the forum, but my VBA knowledge is so poor, I am unable to get them working.

Attached is a sample of how the data currently looks is in my post below.

Thanks!

Thanks Marcol

I have attached an example of the original post.

Cheers

Here is some basic code - not clear from the sample if Line Item & Text Identifier also need to be considered or not ?

(below assumes data sorted by PO number and Text Description per the sample)

Sub Example()
    Dim wsBefore As Worksheet, wsAfter As Worksheet
    Dim vText As Variant
    Dim lngPO As Long, lngRow As Long, lngLast As Long
    Dim xlCalc As XlCalculation
    On Error GoTo Handler
    With Application
        xlCalc = .Calculation
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    Set wsBefore = Sheets("Before")
    Set wsAfter = Sheets.Add
    With wsAfter
        .Name = "After_" & Format(Now(), "ddmmyyhhmmss")
        .Range("A1:E1").Value = wsBefore.Range("A1:E1").Value
    End With
    With wsBefore
        For lngRow = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            lngPO = CLng(.Cells(lngRow, "A").Value)
            If lngPO > 0 Then
                If InStr(1, .Cells(lngRow, "D"), "Header Note", vbTextCompare) Then
                    lngLast = lngRow
                Else
                    lngLast = Application.WorksheetFunction.Match(lngPO, .Columns(1))
                End If
                With .Range(.Cells(lngRow, "E"), .Cells(lngLast, "E"))
                    vText = .Parent.Evaluate("TRANSPOSE(IF(ROW(" & .Address & ")," & .Address & "))")
                End With
                With wsAfter
                    With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                        .Resize(, 4).Value = wsBefore.Cells(lngRow, "A").Resize(, 4).Value
                        .Offset(, 4).Value = Join(vText, " ")
                    End With
                End With
                lngRow = lngLast
            End If
        Next lngRow
    End With
    wsAfter.Columns("A:E").AutoFit
ExitPoint:
    Set wsBefore = Nothing
    Set wsAfter = Nothing
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalc
        .EnableEvents = True
    End With
    On Error GoTo 0
    Exit Sub

Handler:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    Resume ExitPoint
End Sub

Working example attached.

Are you referring to the sample file or your own file ?

Note in the sample file wsBefore is specified as being named "Before" - modify as appropriate.