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.
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
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