Trim text by length and insert rows; include empty cells if already exist

Question

For column C, I need to trim text by length and insert rows, and if empty cells already exist in column C, carry them over. Next, I need to create empty cells for columns A & B from the new cells created in column C by the trim. Last, if there is data in Column A & B, but Column C has no data, the data from A & B should be carried over. Currently, it doesn't.

Sub test()
Dim txt As String, temp As String, colA As String, colB As String
Dim a, b() As String, n, i As Long
Const myLen As Long = 70
a = Range("a1").CurrentRegion.Value
ReDim b(1 To Rows.Count, 1 To 3)
For i = 1 To UBound(a, 1)
    If a(i, 1) <> "" Then
        colA = a(i, 1)
        colB = a(i, 2)
        txt = Trim(a(i, 3))
        Do While Len(txt)
            If Len(txt) <= myLen Then
                temp = txt
            Else
                temp = Left$(txt, InStrRev(txt, " ", myLen))
            End If
            If temp = "" Then Exit Do
            n = n + 1
            b(n, 1) = colA: b(n, 2) = colB
            b(n, 3) = Trim(temp)
            txt = Trim(Mid$(txt, Len(temp) + 1))
        Loop
    End If
Next
Range("e1").Resize(n, 3).Value = b
End Sub

What code is doing What code should do

I tried to work on using not with "" and the ReDim.

Answer 1

• Comment out If a(i, 1) <> "" Then and End If to include blank cells on Col A.
• Const MAX_CNT represents the maximum number of rows after splitting each row of data.
• If you resize the array using Redim after the first Redim, it can only change the last dimension. It's easier to declare a large enough array initially to handle the data.

Sub test()
    Dim txt As String, temp As String, colA As String, colB As String
    Dim a, b() As String, n, i As Long
    Const myLen As Long = 70
    Const MAX_CNT As Long = 10  ' modify as needed
    a = Range("a1").CurrentRegion.Value
    ReDim b(1 To Rows.Count * MAX_CNT, 1 To 3)
    For i = 1 To UBound(a, 1)
'        If a(i, 1) <> "" Then ' ** remove
            colA = a(i, 1)
            colB = a(i, 2)
            txt = Trim(a(i, 3))
            Do While Len(txt)
                If Len(txt) <= myLen Then
                    temp = txt
                Else
                    temp = Left$(txt, InStrRev(txt, " ", myLen))
                End If
                If temp = "" Then Exit Do
                n = n + 1
                b(n, 1) = colA
                b(n, 2) = colB
                b(n, 3) = Trim(temp)
                txt = Trim(Mid$(txt, Len(temp) + 1))
            Loop
'        End If ' ** remove
    Next
    Range("e1").Resize(n, 3).Value = b
End Sub