View Single Post
 
Old 06-28-2018, 08:15 PM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Location: British Columbia, Canada
Posts: 842
NoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of lightNoSparks is a glorious beacon of light
Default

Quote:
Originally Posted by emmorel View Post
The suggested Vba Macro provided the results I was looking for. Below is a small sample of the output.
By chance is there a few words missing in the above quote?

Are you now saying the new sample output is what you would prefer?
If so, try this way
Code:
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
Reply With Quote