columns to rows macro

  • Thread starter Thread starter Paul G
  • Start date Start date
P

Paul G

I have a spread sheet with Account #'s and Names in rows
A&B then addtional address information in Column C but it
goes down the column:

A B C

12798 Herman Munster 1313 Mockingbird lane
smallville
usa
10000
11642 Gomez Adams The Pentagon
Washington DC
65456 Gilligan c/o the Skipper
Deserted Island
The Pacific

Sometimes the address column relating to the name takes up
3, 4 or 5 fields going down.

Other than cutting and pasting special, is there a way for
me to create a macro that will put all the address info in
the same row as the name and account # using the change of
account number in column A as the point to start?

Thanks,

Paul
 
If someone doesn't come up with a neater solution (which
I'd love to have myself!)you can do this:

1.Add a counter column in Col D
2.In the first data row set the Col D counter =1
3.In all succeeding Col D rows IF test for null in first
data column (Col A); if IS null cycle counter to previous
counter +1; if NOT null, reset counter =1; thus you'll
number each address row in a set from 1 to whatever
(2,3,4,5,whatever)
4.In Col E, IF test D Col counter in next row; if
counter=2, set cell =Col C content in tested row; if
NOT=2, set cell=""
5.In Col F, IF test D col counter two rows down; if
counter=3, set cell=C Col content in tested row; if NOT=3,
set cell=""
6.etc. for as many columns as you think you might need
7.When you get the result you want (some logic tweaking
may be needed), MAKE SURE YOU DO THE FOLLOWING
8.Copy and paste VALUES in all newly filled cells - you
must replace the IF testresults with the new data!
9.Delete the counter column D.
10.Sort the data on Column A; all the address extension
rows will cluster together and can be deleted.
11.STRONGLY ADVISE YOU SAVE A COPY OF THE ORIGINAL SHEET
AND MAKE PERIODIC SAVES AS YOU GO ALONG.

Hope this helps.
 
Paul,

Sub FixPaulsAccounts()
Dim myCell As Range
For Each myCell In Range("A:A").SpecialCells(xlCellTypeBlanks)
myCell.End(xlUp).End(xlToRight)(1, 2).Value = _
myCell.End(xlToRight).Value
Next myCell
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

HTH,
Bernie
MS Excel MVP
 
Back
Top