I found this code snippet in Google groups and it works to do what I
need done - move contents of A2 to B1, contents of A3 to C1.
But I need it to do it for some 500 or so records, and it won't go
past the first one.

I tried a Do While...Next loop where it should continue while r0 but
that first put the data into b and c and on the next loop it took it
back out!! I haven't a clue why that is happening.

I then thouhgt if I deleted the now empty rows, the next addr would
then be in A1, but of course, that deleted the successful move from
the first round of the code.

I'm at a loss how to access the rest of the addresses to get them into
the new format.
Could someone please help me with this - or perhaps I should use a
different approach. I was thinking if I move the info into A1, B1 and
C1 of a second sheet, then deleted all the empty rows so that the next
addr is now at A1, I could do it that way and then just dump the empty
sheet.
As you can see, I am fumbling in the dark. Please help

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).Value = ""
Range("A1").Offset(I + 1, 0).Value = ""

End Sub

Joanne wrote:
I found this code snippet in Google groups and it works to do what I
need done - move contents of A2 to B1, contents of A3 to C1.
But I need it to do it for some 500 or so records, and it won't go
past the first one.

I tried a Do While...Next loop where it should continue while r0 but
that first put the data into b and c and on the next loop it took it
back out!! I haven't a clue why that is happening.

I then thouhgt if I deleted the now empty rows, the next addr would
then be in A1, but of course, that deleted the successful move from
the first round of the code.

I'm at a loss how to access the rest of the addresses to get them into
the new format.
Could someone please help me with this - or perhaps I should use a
different approach. I was thinking if I move the info into A1, B1 and
C1 of a second sheet, then deleted all the empty rows so that the next
addr is now at A1, I could do it that way and then just dump the empty
sheet.
As you can see, I am fumbling in the dark. Please help

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).Value = ""
Range("A1").Offset(I + 1, 0).Value = ""

End Sub

Can you attach say 5 of your 500+ addresses in the xls so I can see
how they are laid out on the sheet.
My first thougts are :
1/ You are on the right track: the resorted data should to a second
sheet so that you don't corrupt you source data with you macro.
2/ instead of using "range" I would use cells( i,j) or
activecell.offset ( i,j) .value ..i find it easier that using range.

try 1 of theese:

Sub tst()
Dim r, I, I1
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I - I1, 2) = Cells(I + 1, 1)
Cells(I - I1, 3) = Cells(I + 2, 1)
I1 = I1 + 1
Next
End Sub

Sub Xtst()
Dim r, I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I, 2) = Cells(I + 1, 1)
Cells(I, 3) = Cells(I + 2, 1)
Next
End Sub

"Joanne" skrev:

I found this code snippet in Google groups and it works to do what I
need done - move contents of A2 to B1, contents of A3 to C1.
But I need it to do it for some 500 or so records, and it won't go
past the first one.

I tried a Do While...Next loop where it should continue while r0 but
that first put the data into b and c and on the next loop it took it
back out!! I haven't a clue why that is happening.

I then thouhgt if I deleted the now empty rows, the next addr would
then be in A1, but of course, that deleted the successful move from
the first round of the code.

I'm at a loss how to access the rest of the addresses to get them into
the new format.
Could someone please help me with this - or perhaps I should use a
different approach. I was thinking if I move the info into A1, B1 and
C1 of a second sheet, then deleted all the empty rows so that the next
addr is now at A1, I could do it that way and then just dump the empty
sheet.
As you can see, I am fumbling in the dark. Please help

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).Value = ""
Range("A1").Offset(I + 1, 0).Value = ""

End Sub

Thanks for your input
Sorry to say they do not work
The subroutines work on the first set of 3 lines doing what is
expected - then they grab the first line of the second set of 3 lines
and place it in C3, and then the loop ends.
Any ideas to fix this sure would be appreciated, as is your efforts so
far.
Again, thanks

excelent wrote:

Sub Xtst()
Dim r, I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I, 2) = Cells(I + 1, 1)
Cells(I, 3) = Cells(I + 2, 1)
Next
End Sub

Joanne wrote:
Thanks for your input
Sorry to say they do not work
The subroutines work on the first set of 3 lines doing what is
expected - then they grab the first line of the second set of 3 lines
and place it in C3, and then the loop ends.
Any ideas to fix this sure would be appreciated, as is your efforts so
far.
Again, thanks

excelent wrote:

Sub Xtst()
Dim r, I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I, 2) = Cells(I + 1, 1)
Cells(I, 3) = Cells(I + 2, 1)
Next
End Sub




Try this one I think it should work for you


Sub tst()
Sheet1.Select

Dim r As Integer
Dim I As Integer
Dim J As Integer

J = 1
r = Sheet1.Range("A1").CurrentRegion.Rows.Count
For I = 1 To r

Sheet2.Cells(J + 1, 1).Value = Sheet1.Cells(I, 1).Value
Sheet2.Cells(J + 2, 1).Value = Sheet1.Cells(I, 2).Value
Sheet2.Cells(J + 3, 1).Value = Sheet1.Cells(I, 3).Value
J = J + 3
Next I

End Sub

Steve
Thanks for the code
It doesn't work in that it only moves the first address label to
sheet2. Then the loop stops and the other 500+ labels are still in the
incorrect format and living on sheet1. It also puts the data in
sheet2 in column A only, and in separate cells, so I actually end up
with what I already have, except it was triple-spaced until I changed
J = J + 3 to J = J + 1.
I appreciate your time and efforts
Joanne

stevebriz wrote:


Joanne wrote:
Thanks for your input
Sorry to say they do not work
The subroutines work on the first set of 3 lines doing what is
expected - then they grab the first line of the second set of 3 lines
and place it in C3, and then the loop ends.
Any ideas to fix this sure would be appreciated, as is your efforts so
far.
Again, thanks

excelent wrote:

Sub Xtst()
Dim r, I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I, 2) = Cells(I + 1, 1)
Cells(I, 3) = Cells(I + 2, 1)
Next
End Sub




Try this one I think it should work for you


Sub tst()
Sheet1.Select

Dim r As Integer
Dim I As Integer
Dim J As Integer

J = 1
r = Sheet1.Range("A1").CurrentRegion.Rows.Count
For I = 1 To r

Sheet2.Cells(J + 1, 1).Value = Sheet1.Cells(I, 1).Value
Sheet2.Cells(J + 2, 1).Value = Sheet1.Cells(I, 2).Value
Sheet2.Cells(J + 3, 1).Value = Sheet1.Cells(I, 3).Value
J = J + 3
Next I

End Sub

Joanne,
If you haven't got it working and you want more help then send me the
xls and I will have a look at if for you..
maybe I missunderstood what you are trying to do.

Joanne wrote:
Steve
Thanks for the code
It doesn't work in that it only moves the first address label to
sheet2. Then the loop stops and the other 500+ labels are still in the
incorrect format and living on sheet1. It also puts the data in
sheet2 in column A only, and in separate cells, so I actually end up
with what I already have, except it was triple-spaced until I changed
J = J + 3 to J = J + 1.
I appreciate your time and efforts
Joanne

stevebriz wrote:


Joanne wrote:
Thanks for your input
Sorry to say they do not work
The subroutines work on the first set of 3 lines doing what is
expected - then they grab the first line of the second set of 3 lines
and place it in C3, and then the loop ends.
Any ideas to fix this sure would be appreciated, as is your efforts so
far.
Again, thanks

excelent wrote:

Sub Xtst()
Dim r, I
r = Range("A1").CurrentRegion.Rows.Count
For I = 1 To r Step 2
Cells(I, 2) = Cells(I + 1, 1)
Cells(I, 3) = Cells(I + 2, 1)
Next
End Sub




Try this one I think it should work for you


Sub tst()
Sheet1.Select

Dim r As Integer
Dim I As Integer
Dim J As Integer

J = 1
r = Sheet1.Range("A1").CurrentRegion.Rows.Count
For I = 1 To r

Sheet2.Cells(J + 1, 1).Value = Sheet1.Cells(I, 1).Value
Sheet2.Cells(J + 2, 1).Value = Sheet1.Cells(I, 2).Value
Sheet2.Cells(J + 3, 1).Value = Sheet1.Cells(I, 3).Value
J = J + 3
Next I

End Sub