Sub MergeCodes_v2()
    Dim i As Long, lr As Long
    Dim rng As Range, cel As Range
    Dim str As String
    
With Sheets("Sheet1")    '<~~ change to actual sheet name
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    'add row for merge string
    For i = lr To 2 Step -1
        If Len(.Cells(i, "A")) = 10 Then
            .Rows(i + 1).Insert
        End If
    Next i
    'recalc lastrow
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    Set rng = .Range("A2:A" & lr)
End With
    
For Each cel In rng
    cel.Select
    If cel.Value = "" Then
        For i = 1 To lr
            If Len(cel.Offset(i).Value) < 10 And cel.Offset(i).Value <> "" Then
                str = str & ", " & cel.Offset(i).Value
            Else
                cel.Value = Mid(str, 3)
                cel.Font.Bold = False
                str = ""
                Exit For
            End If
        Next i
    End If
Next cel
    
End Sub