making labels
 

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

making labels
 

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.

making labels
 

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

making labels
 

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

making labels
 

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

making labels
 

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

making labels
 

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