moving columns to rows....

[jbyrne]

IN SOME CASES I HAVE THE SAME NAME WITH MULTIPLE ADDRESSES. FOR EXAMPLE

COLUMN A B C D E
JOHN SMITH 123 MAIN ST ANYTOWN NJ 07622
JOHN SMITH 421 SOUTH DR ANYTOWN NJ 07624
JOHN SMITH 923 9TH AVE ANYTOWN NJ 07221
MARY DOE 123 5TH ST ANYTOWN OH 23473
MARY DOE 523 2ND ST ANYTOWN PA 34737

WHAT I WANT TO DO IS HAVE THE ADDRESSES GOING ACCROSS INSTEAD OF DOWNWARD IN THE COLUMN. EXAMPLE ABOVE (IF SAME NAME MOVE B2 TO F1)

ANY IDEAS?

 

[Jay Petrulis]

Hi,

http://www.mrexcel.com/board/viewtopic.php?topic=6317&forum=2&4

does something similar.

I would recommend that you concatenate the first and last names in another column and then try the above procedure (adapt it, of course).

HTH,
Jay

 

[jbyrne]

Thanks Jay,

I'm learning more and more about excel every day. I'm not to sure where I paste the code and how do I start it.

 

[Jay Petrulis]

Hi,

I misread your post a bit. I was under the impression that the names were in separate columns. I think they are complete and in column A. You do *not* need to manipulate the original data in any way then.

Below the instructions are the modified code. Let me know if this works for you.

1. Make sure your data is on the active sheet.

2. Make sure the active sheet is not Sheet2

3. Copy the code below

4. Go back to Excel and hold down the Alt key while depressing the F11 key on the top row. (Alt-F11). You will now be in the Visual Basic Editor (VBE)

5. From the top menu Insert>Module

6. Paste the code you copied.

7. Type Alt-Q to exit the VBE and return to Excel proper.

8. Run the program, by doing either:

a) Tools>Macro>Macros choose test and hit OK
b) Alt+F8 and choose test, OK.

'---begin VBA---
Sub test()
Dim counter As Long, lastrow As Long, x As Long
Dim matchrow As Long, lastcol As Integer

With ActiveSheet
.UsedRange
lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row
.Columns("G:G").Clear
.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range("G1"), Unique:=True
.Range("G1").Delete shift:=xlUp

counter = WorksheetFunction.CountA(.Range("G:G"))
.Range("G1:G" & counter).Copy Sheets("sheet2").Range("A1")
.Range("G1:G" & counter).ClearContents

For x = 2 To lastrow
matchrow = Application.Match(.Cells(x, 1), Sheets("Sheet2").Range("A:A"), 0)
lastcol = Sheets("Sheet2").Cells(matchrow, 256).End(xlToLeft).Column
.Range(.Cells(x, 2), .Cells(x, 5)).Copy Sheets("Sheet2").Cells(matchrow, lastcol + 1)
Next x
End With
MsgBox "Done!"

End Sub
'---end VBA---

Please post back if you have any troubles.

Bye,
Jay

 

[jbyrne]

Thanks Jay,

I'll let you know how I do!

Jim

 

[jbyrne]

Hi Jay,

It worked GREAT! Now I just need to adjust it a little bit...

On sheet 2, I just need the additional addresses and the dates of the individuals. (Columns B thru H)

Also Jay, is it possible to include the 1st record as well on sheet 2?

I appreciate all the help you are giving me!!

 

[jbyrne]

Sorry Jay, I responded to the wrong thread. I will now respond to this thread only... my last response was due to your response about inserting the following sub

Sub test()
Dim counter As Long, lastrow As Long, x As Long
Dim matchrow As Long, lastcol As Integer

With ActiveSheet
.UsedRange
lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row
.Columns("N:N").Clear
.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range("N1"), Unique:=True
.Range("N1").Delete shift:=xlUp

counter = WorksheetFunction.CountA(.Range("N:N"))
.Range("N1:N" & counter).Copy Sheets("sheet2").Range("A1")
.Range("N1:N" & counter).ClearContents

For x = 2 To lastrow
matchrow = Application.Match(.Cells(x, 1), Sheets("Sheet2").Range("A:A"), 0)
lastcol = Sheets("Sheet2").Cells(matchrow, 256).End(xlToLeft).Column
.Range(.Cells(x, 2), .Cells(x, 13)).Copy Sheets("Sheet2").Cells(matchrow, lastcol + 1)
Next x
End With
MsgBox "Done!"

End Sub

 

[Jay Petrulis]

Response sent through private e-mail. Did not realize you had sent to group as well.

To only transfer Col's B through H, change
.Range(.Cells(x, 2), .Cells(x, 13)).Copy
to
.Range(.Cells(x, 2), .Cells(x, 8)).Copy

To include first record (I assumed you had category headers), change
For x = 2 To lastrow
to
For x = 1 To lastrow

Bye,
Jay
This message was edited by Jay Petrulis on 2002-04-26 12:27

 

[fb250r]

Hello Jay,

I have a similar problem that I posted under "Combine data". I tried your posted suggestion but it's not quite there.

Any Suggestions?

Regards,

Frank

 

[Jay Petrulis]

Hi Frank,

This is becoming a popular routine. If your original data does *not* have a category header, then change

For x = 2 To lastrow
to
For x = 1 To lastrow

Here is the sub rewritten if only columns A and B hold data that needs to be transferred.

Sub test()
Dim counter As Long, lastrow As Long, x As Long
Dim matchrow As Long, lastcol As Integer

With ActiveSheet
.UsedRange
lastrow = .Cells.SpecialCells(xlCellTypeLastCell).Row
.Columns("N:N").Clear
.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range("N1"), Unique:=True
.Range("N1").Delete shift:=xlUp

counter = WorksheetFunction.CountA(.Range("N:N"))
.Range("N1:N" & counter).Copy Sheets("sheet2").Range("A1")
.Range("N1:N" & counter).ClearContents

For x = 2 To lastrow
matchrow = Application.Match(.Cells(x, 1), Sheets("Sheet2").Range("A:A"), 0)
lastcol = Sheets("Sheet2").Cells(matchrow, 256).End(xlToLeft).Column
.Cells(x, 2).Copy Sheets("Sheet2").Cells(matchrow, lastcol + 1)
Next x
End With
MsgBox "Done!"

End Sub

Bye,
Jay