Need Help with Macro
 

"excelmad" wrote:

I have a Macro that I want to move data from a row to a column based on a
data in column A. My data range is Sheet 1 - A:P with the data to copy
beginning in column Q select A:P, copy into a new sheet, and delete A:P. The
macro is working for columns A and B but is not looking at C to P at all.
Can you tell me where I've gone wrong here?

Any help is appreciated

Ex of data

Column A Column B Column C Column D
111-11-1111 Anthony Adams Chicago
111-11-1111 John Lacey Chicago
222-22-2222 Ingrid Edwards Denver
333-33-3333 Justin Abrahms Atlanta
333-33-3333 Ellie Winn Philadelphia
333-33-3333 Elijah Whitfield Philadelphia
333-33-3333 Ellie Winn Orlando
333-33-3333 Natalie Adams Boston
444-44-4444 Aston Langford Boston
444-44-4444 Marcus Baston Chicago
444-44-4444 Thomas Taylor Philadelphia

Result Wanted:
111-11-1111 Anthony Adams Chicago John Lacey Chicago
Same for all in column A

Sub ReArrange()
Dim FirstCell As Range
Dim LastCell As Range
Dim Dest As Range
Dim c As Long
Set FirstCell = Range("A1")
Do Until FirstCell.Value = ""
For c = 1 To 20
If FirstCell.Offset(c).Value < FirstCell.Value Then
Set LastCell = FirstCell.Offset(c - 1)
Set Dest = Range("Q" & Rows.Count).End(xlUp).Offset(1)
Exit For
End If
Next c
Dest.Value = FirstCell.Value
For c = 1 To Range(FirstCell, LastCell).Count
Dest.Offset(, c).Value = FirstCell.Offset(c - 1, 1).Value
Next c
Set FirstCell = LastCell.Offset(1)
Loop
Columns("A:P").Select
Columns("A:P").Copy
Sheets.Add
Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Columns("A:P").Delete
MsgBox "Run Complete"
End Sub

Set Dest = Range("Q" & Rows.Count).End(xlUp).Offset(1)
is a dangerous mvoe. You may end up something like this

Column A Column B Column C Column D
111-11-1111 Anthony Adams Chicago
222-22-2222 Ingrid Edwards Denver
222-22-2222 Justin Abrahms Atlanta

Improper destination.
111-11-1111 Anthony Adams Chicago Justin Abrahms Atlanta
222-22-2222 Ingrid Edwards Denver

To fix that. You can record the first 222-22-2222 row. Than past your data
to that place.

But IMO, I will do an dirty approach to your need.
First locate last column of your entire data using Find("*", From
Cells(Row.count, Column.count), ByColumn, searchBackward)
Than
when you want to copy and paste
just copy from cells(i, 2) to Cells(i, lastCol), and paste it to cells(i-1,
lastCol +1)
and delete Row(i)

OK, this only work for copying one row.
For more copy and paste,
ColumnMultiplier = lastCol -1
CountHowManyTimesYouAlreadyPasted.
And Destination = cells(i-1, lastCol + ColumnMultiplier *
CountHowManyTimesYouAlreadyPasted +1)



Try not to use the xEnd. It is dangerous operation because you can't predict
where your selection will end up. See that I didn't use xEnd to find the last
column for the same reason.