columns to columns and rows

[mike31z]

I have a single page worksheet. The data is Names (in A2) Address (in A3) City, St Zip (in A4) and so on; repeated from A2 to A109.

Would some help me create a macro to modify the format from a column listing that was copied from a PDF file to a column / row list that I can use to print this list on to envelopes vs labels.

Mike P
Highland Wi, USA

I am using Office 2019 and Win 10

[mancubus]

do you want to convert one column data to 4 column data?

A2:A5 to C2:F2 for example?
(keeping original data in col A and leaving col B blank)

[mancubus]

Sub vbax_70785_Split_1Col_Data_to_4Cols_Data()
'adapted from:
''https://superuser.com/questions/359617/convert-one-column-into-multiple-rows
'20220419

Dim i&, j&, iRow&, sttCol&
Dim arrSource As Variant

iRow = 2
sttCol = 3

With ActiveSheet
'arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
arrSource = .Range("A2:A109").Value

For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 4) Step 4
For j = 0 To 3
.Cells(iRow, sttCol + j) = arrSource(i + j, 1)
Next j
iRow = iRow + 1
Next i

'add the remaining values
Select Case UBound(arrSource) Mod 4
Case 1 'one item to add
.Cells(iRow, 3) = arrSource(i + 0, 1)
Case 2 'still two items to add
.Cells(iRow, 3) = arrSource(i + 0, 1)
.Cells(iRow, 4) = arrSource(i + 1, 1)
Case 3 'still three items to add
.Cells(iRow, 3) = arrSource(i + 0, 1)
.Cells(iRow, 4) = arrSource(i + 1, 1)
.Cells(iRow, 5) = arrSource(i + 2, 1)
Case Else 'nothing to add
End Select

End With


End Sub

[mancubus]

if you exactly know you have no remaining values, then:



Sub vbax_70785_Split_1Col_Data_to_4Cols_Data()
'adapted from:
''https://superuser.com/questions/359617/convert-one-column-into-multiple-rows
'20220419

Dim i&, iRow&, sttCol&
Dim arrSource As Variant

iRow = 2
sttCol = 3

With ActiveSheet
'arrSource = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
arrSource = .Range("A2:A109").Value

For i = 1 To (UBound(arrSource) - UBound(arrSource) Mod 4) Step 4
For j = 0 To 3
.Cells(iRow, sttCol + j) = arrSource(i + j, 1)
Next j
iRow = iRow + 1
Next i

End With


End Sub

[Paul_Hossler]

It would be helpful and avoid a lot of questions if you would attach a small sample workbook with the before and after

[georgiboy]

Does Excel 2019 have the SEQUENCE function, I keep forgetting?

[mike31z]

Thanks for looking and posting.
mancubus; Your first VBA worked but used 4 rows of column A and put the data into

I have uploaded a small xls workbook so you can better understand my dilemma.

I need column a to be converted to C2 {Name}, D2 {Address}, E2 {City, State, Zip}.

[Paul_Hossler]

You didn't say, I assumed you wanted the output in sequential rows

30736




Option Explicit


Sub AtoCDE()
Dim i As Long, o As Long

o = 2

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row - 2 Step 3
.Cells(o, 3).Value = .Cells(i, 1).Value
.Cells(o, 4).Value = .Cells(i + 1, 1).Value
.Cells(o, 5).Value = .Cells(i + 2, 1).Value

o = o + 1
Next i
End With


End Sub

[mike31z]

Thats what I wanted in rows and columns. I can always correct spacing with data sort.
I tested it in my sample copy and then the real data. It work, Thank You.
I have this same problem 3 more times this year. Can I just paste your code in the module for each of the spread sheets and make it work?

Mike P
Highland WI

[Paul_Hossler]

Should be able to, but it runs on which sheet is active and starts in A2

If there's a lot of date, turning off screen update will be a little faster



Option Explicit


Sub AtoCDE()
Dim i As Long, o As Long

o = 2

Application.ScreenUpdating = False

With ActiveSheet
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row - 2 Step 3
.Cells(o, 3).Value = .Cells(i, 1).Value
.Cells(o, 4).Value = .Cells(i + 1, 1).Value
.Cells(o, 5).Value = .Cells(i + 2, 1).Value

o = o + 1
Next i
End With


Application.ScreenUpdating = Truw



End Sub