Concatenate Each Row To Cells In Column

Option Explicit


Sub wo_Consolidate_Comments()
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim strComment As String
    Dim rngComment As Range
    Dim lngrows As Long
    Dim intCounter As Integer
    Dim intRecord As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")
    lngrows = wsData.Range("A65536").End(xlUp).Row
    intCounter = 2
    intRecord = intCounter
    strComment = wsData.Cells(intCounter, 5)


    With wsData
        Do While lngrows >= 2
            rngComment = .Cells(intCounter, 5)
            
            If .Cells(intCounter, 1) = .Cells(intCounter + 1, 1) Then
                strComment = strComment + .Cells(intCounter + 1, 5)
            Else
                rngComment = strComment
                intRecord = intCounter
            End If
            
            intCounter = intCounter + 1
            lngrows = lngrows - 1
        Loop
    End With
            
        
    
    '//Cleanup
    Set wbBook = Nothing
    Set wsData = Nothing
    Set rngComment = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
     
End Sub

Option Explicit


Sub wo_Consolidate_Comments()
    Dim wbBook As Workbook
    Dim wsData As Worksheet
    Dim strComment As String
    Dim rngComment As Range
    Dim lngrows As Long
    Dim intCounter As Integer
    Dim intRecord As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    
    Set wbBook = ThisWorkbook
    Set wsData = wbBook.Worksheets("Data")
    lngrows = wsData.Range("A65536").End(xlUp).Row
    intCounter = 2
    intRecord = intCounter
    strComment = wsData.Cells(intCounter, 5)
    Set rngComment = wsData.Cells(intRecord, 5)
    
    Do While lngrows >= 2
        With wsData
            If .Cells(intCounter + 1, 1) = .Cells(intCounter, 1) Then
                strComment = strComment + " " + .Cells(intCounter + 1, 5).Value
            Else
                Set rngComment = .Cells(intRecord, 5)
                intRecord = intCounter
                rngComment.Value = strComment
                strComment = ""
            End If
            
            intCounter = intCounter + 1
            lngrows = lngrows - 1
        End With
    Loop
    
    Set wbBook = Nothing
    Set wsData = Nothing
    Set rngComment = Nothing
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
     
End Sub