Merge multiple cells in a column to strings no more than 100 characters long

**exceler_52** · 01-23-2013, 12:28 PM

I have a list of text references in column C that I need to combine in to comma seperated strings that are no more than 100 characters each (including spaces and a auto-incremented prefix) in column I.

The incremented prefix needs to start at 10 and increment by 10 for each new line as well as include the text "REM" to generate a quick basic type remark statement.

The attached example shows what the final result needs to be but I have no clue where to begin with macro code for something like this. Please help!

**mike7952** · 01-23-2013, 12:55 PM

This might work

Option Explicit
Sub abc()
 Dim a, b
 Dim i As Long, n As Long
 Dim increment As Long
 a = Range("c1", Cells(Rows.Count, "c").End(xlUp))
 
 ReDim b(0)
 increment = 10
 b(0) = increment & Space(1) & "REM" & Space(1)
 For i = 1 To UBound(a)
    If Len(b(UBound(b))) + Len(a(i, 1)) <= 100 Then
        b(UBound(b)) = b(UBound(b)) & a(i, 1) & ","
    Else
        b(UBound(b)) = Left$(b(UBound(b)), Len(b(UBound(b))) - 1)
        increment = increment + 10
        ReDim Preserve b(UBound(b) + 1)
        b(UBound(b)) = increment & Space(1) & "REM" & Space(1) & a(i, 1) & ","
    End If
 Next
 b(UBound(b)) = Left$(b(UBound(b)), Len(b(UBound(b))) - 1)
 Cells(1, "i").Resize(UBound(b) + 1) = Application.Transpose(b)
End Sub