I have a worksheet that has thousands of rows and only one column `(A)`

. The cells in column A can be null or up to and over `1000`

characters. I need to run a macro that will loop through column A copying it to column `B`

. If there are any cells that have any text `> 60`

characters to cut it into blocks of `60`

into the next columns.

I have code that breaks text into blocks of `60`

but I don’t know how to get it to copy anything under `60`

, move to next row if null or loop through rows.

```
Sub x()
Dim cLength As Long, cLoop As Long
cLength = 60
For cLoop = 1 To (Len([A2]) \ cLength) + 1
[A2].Offset(, cLoop).Value = Mid([A2], ((cLoop - 1) * cLength) + 1, cLength)
Next
End Sub
```

**Fastest way to handle it! (Uses no Loops. Processes the entire column in one go)**

This uses the inbuilt `Data | Text To Columns`

. We are using `Fixed Width`

to split the data. The below code will handle strings up to `1320`

characters in length.

```
Sub Sample()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Columns(1).TextToColumns _
Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
FieldInfo:=Array( _
Array(0, 1), Array(60, 1), Array(120, 1), Array(180, 1), _
Array(240, 1), Array(300, 1), Array(360, 1), Array(420, 1), _
Array(480, 1), Array(540, 1), Array(600, 1), Array(660, 1), _
Array(720, 1), Array(780, 1), Array(840, 1), Array(900, 1), _
Array(960, 1), Array(1020, 1), Array(1080, 1), Array(1140, 1), _
Array(1200, 1), Array(1260, 1), Array(1320, 1) _
), _
TrailingMinusNumbers:=True
End Sub
```

If you were to do it manually then you would be doing this.

### Answer：

Try this. This should do your job:

```
Sub pCopyTextToNextColumn()
Dim wksSheet1 As Worksheet
Dim rngColAData As Range
Dim rngCell As Range
Dim lngLastRow As Long
Dim cLoop As Long
'Set the length
cLength = 60
'Assign worksheet
Set wksSheet1 = Worksheets("Sheet1")
'find last Row in column A
lngLastRow = wksSheet1.Cells(wksSheet1.Rows.Count, 1).End(xlUp).Row
'Set Data range
With wksSheet1
Set rngColAData = .Range(.Cells(1, 1), .Cells(lngLastRow, 1))
End With
'Loop through each cell in column A, and
For Each rngCell In rngColAData.Cells
'Length of the string is greater than 60 then loop through
If Len(Trim(rngCell)) > cLength Then
For cLoop = 1 To (Len(rngCell) \ cLength) + 1
rngCell.Offset(, cLoop).Value = Mid(rngCell, ((cLoop - 1) * cLength) + 1, cLength)
Next
Else
'Else just paste the data in column B
rngCell.Offset(, 1) = rngCell.Value
End If
Next rngCell
'Release Memory
Set wksSheet1 = Nothing
Set rngColAData = Nothing
Set rngCell = Nothing
End Sub
```

### Answer：

Modified your code to make it generic for all rows:

```
Sub x()
Dim cLength As Long
Dim cLoop As Long
Dim i As Long
cLength = 60
i = 1
While i < 1001
For cLoop = 1 To (Len(Cells(i, 1)) \ cLength) + 1
Cells(i, cLoop + 1).Value = Mid(Cells(i, 1), ((cLoop - 1) * cLength) + 1, cLength)
Next
i = i + 1
Wend
End Sub
```

Tags: excelexcel, text