getting close on addresses

[Joanne]

I am still trying to get my labels in proper format.
They are in 3 lines, each line in a separate cell of the same column
I need to get each line in a separate cell in 3 adjacent columns. Such
as:
A1 John Doe
A2 100 Main St
A3 Anytown, USA 66666
to
A1 B1 C1
John Doe 100 Main St Anytown, USA 66666

The following code works, moving the data to the proper cells and
deleting the empty rows - but it only works on the first address then
quits.

Public Sub RowsToCols()
Dim r
Dim I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 3
Range("A1").Offset(I - 1, 1).Value = Range("A1").Offset(I,
0).Value
Range("A1").Offset(I - 1, 2).Value = Range("A1").Offset(I + 1,
0).Value
Range("A1").Offset(I, 0).EntireRow.Delete
Range("A1").Offset(I, 0).EntireRow.Delete
Range("A1").Offset(I, 0).EntireRow.Delete

Next
End Sub

After doing the above job, I need to know how to access the next row
in Col A so that I can repeat the code on the next address, and on and
on until all addresses have been reformatted. I think I am in col 3 at
the end of the subroutine, so all I need to do is go down 1 row and
back to col A, run the code on the next address, go down 1 row and
back to col A again, run the code again etc etc

Any help on this sure would make my day
Thanks for the time and expertise
Joanne

 

[David McRitchie]

Hi Joanne,
There are some examples including a macro module
for the code to go with the page at
http://www.mvps.org/dmcritchie/excel/snakecol.htm
http://www.mvps.org/dmcritchie/excel/code/naddr3ss.txt
http://www.mvps.org/dmcritchie/excel/code/snakecol.txt

I would suggest using the macro to create a new sheet
rather than rearranging the cells on the same sheet.

HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

 

[Dave Peterson]

How about this?

Option Explicit
Sub testme02()

Dim wks As Worksheet
Dim iRow As Long
Dim oRow As Long

Set wks = ActiveSheet

oRow = 1
With wks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step 3
.Cells(oRow, "B").Value = .Cells(iRow, "A").Value
.Cells(oRow, "C").Value = .Cells(iRow + 1, "A").Value
.Cells(oRow, "D").Value = .Cells(iRow + 2, "A").Value
oRow = oRow + 1
Next iRow

.Range("b11").EntireColumn.AutoFit

'after you've tested, you can delete column A
'.Range("A1").EntireColumn.Delete
End With

End Sub

 

[Gord Dibben]

Joanne

Sub ColtoRows()
Dim rng As Range
Dim i As Long
Dim j As Long
Set rng = Cells(Rows.Count, 1).End(xlUp)
j = 1
On Error GoTo endit
nocols = InputBox("Enter Number of Columns Desired")
If nocols = "" Or Not IsNumeric(nocols) Then Exit Sub
For i = 1 To rng.Row Step nocols
Cells(j, "A").Resize(1, nocols).Value = _
Application.Transpose(Cells(i, "A").Resize(nocols, 1))
j = j + 1
Next
Range(Cells(j, "A"), Cells(rng.Row, "A")).ClearContents
Exit Sub
endit:
End Sub


Gord Dibben MS Excel MVP

 

[Joanne]

Hey David
Thanks for the help. Your code lives proudly in my module (and with
all due credit, I might add) and does the job beautifully. Wish I
could do what you can do!!
Joanne

 

[Joanne]

Thank you for the code Dave
I am using Dave Ritchie's code to do the job, but reading your code
and saving it as an example on how to reference cells will help me in
the future I am sure.
Keep up the good work - you guys are great
Joanne

 

[Joanne]

Thank you Gord for your input. While I am not using your code it is in
my personal Excel 'help file' for future reference on how to move
around the cells and rows in a spreadsheet, especially concerning
staying in the same column but moving down the row - that bugger
really had me stymied.
You guys do a great service to us wannabes
Joanne