Shifting cell data to top row

[JNagelvoort]

I need a macro to shift column data to the top row for a given cell range sharing common data in row A.
I need to get from this:
<table x:str="" style="border-collapse: collapse; width: 384px; height: 288px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 42pt;" span="5" width="56"> <tbody><tr style="height: 13.5pt;" height="18"> <td class="xl24" style="height: 13.5pt; width: 42pt;" width="56" height="18">Name</td> <td class="xl22" style="border-left: medium none; width: 42pt;" width="56">Fruit</td> <td class="xl22" style="border-left: medium none; width: 42pt;" width="56">Meat</td> <td class="xl22" style="border-left: medium none; width: 42pt;" width="56">Dairy</td> <td class="xl23" style="border-left: medium none; width: 42pt;" width="56">Bakery</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Alex</td> <td class="xl24">Apples</td> <td class="xl25" style="border-left: medium none;"> </td> <td class="xl25" style="border-left: medium none;"> </td> <td class="xl26" style="border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Alex</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Milk</td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Alex</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Bacon</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Alex</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;">Bread</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Steak</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Eggs</td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Chicken</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl27" style="border-top: medium none;">Oranges</td> <td>
</td> <td class="xl28" style="border-top: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Butter</td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;">Cake</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Milk</td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;">Bananas</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;">Pork</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl33" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl27" style="border-top: medium none;">Peaches</td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl28" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl29" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 13.5pt;" height="18"> <td class="xl34" style="border-top: medium none; height: 13.5pt;" height="18">Carl</td> <td class="xl30" style="border-top: medium none;"> </td> <td class="xl31" style="border-top: medium none; border-left: medium none;">Chicken</td> <td class="xl31" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl32" style="border-top: medium none; border-left: medium none;"> </td> </tr> </tbody></table>
To this:
<table x:str="" style="border-collapse: collapse;" border="0" cellpadding="0" cellspacing="0" width="373" height="104"><col style="width: 42pt;" span="5" width="56"> <tbody><tr style="height: 13.5pt;" height="18"> <td class="xl26" style="height: 13.5pt; width: 42pt;" width="56" height="18">Name</td> <td class="xl24" style="border-left: medium none; width: 42pt;" width="56">Fruit</td> <td class="xl24" style="border-left: medium none; width: 42pt;" width="56">Meat</td> <td class="xl24" style="border-left: medium none; width: 42pt;" width="56">Dairy</td> <td class="xl25" style="border-left: medium none; width: 42pt;" width="56">Bakery</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl35" style="border-top: medium none; height: 12.75pt;" height="17">Alex</td> <td class="xl26">Apples</td> <td class="xl27" style="border-left: medium none;">Bacon</td> <td class="xl27" style="border-left: medium none;">Milk</td> <td class="xl28" style="border-left: medium none;">Bread</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl35" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl29" style="border-top: medium none;">Oranges</td> <td class="xl30" style="border-top: medium none; border-left: medium none;">Chicken</td> <td class="xl30" style="border-top: medium none; border-left: medium none;">Eggs</td> <td class="xl31" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl35" style="border-top: medium none; height: 12.75pt;" height="17">Bill</td> <td class="xl29" style="border-top: medium none;"> </td> <td class="xl30" style="border-top: medium none; border-left: medium none;">Steak</td> <td class="xl30" style="border-top: medium none; border-left: medium none;"> </td> <td class="xl31" style="border-top: medium none; border-left: medium none;"> </td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl35" style="border-top: medium none; height: 12.75pt;" height="17">Carl</td> <td class="xl29" style="border-top: medium none;">Bananas</td> <td class="xl30" style="border-top: medium none; border-left: medium none;">Chicken</td> <td class="xl30" style="border-top: medium none; border-left: medium none;">Butter</td> <td class="xl31" style="border-top: medium none; border-left: medium none;">Cake</td> </tr> <tr style="height: 13.5pt;" height="18"> <td class="xl36" style="border-top: medium none; height: 13.5pt;" height="18">Carl</td> <td class="xl32" style="border-top: medium none;">Peaches</td> <td class="xl33" style="border-top: medium none; border-left: medium none;">Pork</td> <td class="xl33" style="border-top: medium none; border-left: medium none;">Milk</td> <td class="xl34" style="border-top: medium none; border-left: medium none;"> </td> </tr> </tbody></table>
It would be nice if the shifting would sort the data as well.

 

[Peter_SSs]

Welcome to the MrExcel board!

Try this on a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>    <SPAN style="color:#00007F">Dim</SPAN> sr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, er <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, col <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> DelRange <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Columns("A:E").Insert<br>    Range("A1:E1").Value = Range("F1:J1").Value<br>    sr = 2: er = sr<br>    <SPAN style="color:#00007F">Do</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> Cells(er + 1, 6).Value = Cells(er, 6).Value <SPAN style="color:#00007F">Then</SPAN><br>            er = er + 1<br>        <SPAN style="color:#00007F">Else</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> Cells(sr, 1).Resize(er - sr + 1, 5)<br>                .Value = .Offset(, 5).Value<br>                <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>                .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp<br>                <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>                <SPAN style="color:#00007F">For</SPAN> col = 2 <SPAN style="color:#00007F">To</SPAN> 5<br>                    .Columns(col).Sort Key1:=.Cells(1, col), Order1:=xlAscending, _<br>                        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _<br>                        Orientation:=xlTop<SPAN style="color:#00007F">To</SPAN>Bottom, DataOption1:=xlSortNormal<br>                <SPAN style="color:#00007F">Next</SPAN> col<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            sr = er + 1: er = sr<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> Cells(er, 6).Value <> ""<br>    <SPAN style="color:#00007F">With</SPAN> Range("A1:E" & er)<br>        <SPAN style="color:#00007F">For</SPAN> col = 2 To 5<br>            .AutoFilter Field:=col, Criteria1:="="<br>        <SPAN style="color:#00007F">Next</SPAN> col<br>        <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> DelRange = .Offset(1).SpecialCells(xlCellTypeVisible)<br>        <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>        .AutoFilter<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> DelRange <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        DelRange.Delete Shift:=xlUp<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    Columns("F:J").Delete<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[jindon]

Sub test()
Dim a, b(), i As Long, ii As Long, n As Long
With Range("a1").CurrentRegion
    a = .Value
    ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                n = n + 1 : b(n, 1) = a(i, 1)) : .add a(i, 1), n
            End If
            For ii = 2 To UBound(a, 2)
                If a(i, ii) <> "" Then b(.item(a(i, 1)), ii) = a(i, ii)
            Next
        Next
    End With
    .Value = b
    .Sort Range("a2"), 1
End With
End Sub

 

[JNagelvoort]

Thank you Peter SSs and jindon.

Peter SSs: Your macro worked great. Can your macro be modified to work within a selected range of cells without damaging other cells data above, below or besides the cell range being sorted?
I do not always have specifically 5 columns of data. I may have only 2 columns or maybe 12 or even 15 columns which all require rearranging towards the top row. The first, left most, column in the selection is always the grouping control data column, but the total amount of columns will vary.
e.g.
I may need to rearrange data within the cell range of C5:K223, with out damaging any data from the surrounding cells like A3, D3, L28, or E224.

jindon: I could not get your macro to work. It would always report the following error.
Compile error:
Syntax error
And the macro line: n = n + 1 : b(n, 1) = a(i, 1)) : .add a(i, 1), n would be highlighted.

Thank for your help.
Jon

 

[Peter_SSs]

Jon

I'm not real clear on that. Suppose we start with ...

Excel Workbook
	A	B	C	D	E
1	Name	Fruit	Meat	Dairy	Bakery
2	Alex	Apples
3	Alex			Milk
4	Alex		Bacon
5	Alex				Bread
6	Bill		Steak
7	Bill			Eggs
8	Bill		Chicken
9	Bill	Oranges
10	Carl			Butter
11	Carl				Cake
12	Carl			Milk
13	Carl	Bananas
14	Carl		Pork
15	Carl	Peaches
16	Carl		Chicken
Rearrange (4)

Are you saying that if we started with the above and the blue area was 'selected' before running the code, then the result after running the code would be this?

Excel Workbook
	A	B	C	D	E
1	Name	Fruit	Meat	Dairy	Bakery
2	Alex	Apples
3	Alex			Milk
4	Alex		Bacon
5	Alex				Bread
6	Bill	Oranges	Chicken	Eggs
7	Bill		Steak
8
9
10	Carl			Butter
11	Carl				Cake
12	Carl			Milk
13	Carl	Bananas
14	Carl		Pork
15	Carl	Peaches
16	Carl		Chicken
Rearrange (3)

Or maybe A8:A9 would still contain "Bill" as well?


And if the yellow section had been selected instead, you would expect this?

Excel Workbook
	A	B	C	D	E
1	Name	Fruit	Meat	Dairy	Bakery
2	Alex	Apples	Bacon
3	Alex			Milk
4
5	Alex				Bread
6	Bill		Steak
7	Bill			Eggs
8	Bill		Chicken
9	Bill	Oranges
10	Carl			Butter
11	Carl				Cake
12	Carl			Milk
13	Carl	Bananas
14	Carl		Pork
15	Carl	Peaches
16	Carl		Chicken
Rearrange (5)

 

[jindon]

And the macro line: n = n + 1 : b(n, 1) = a(i, 1)) : .add a(i, 1), n would be highlighted.

Too many ")"
should be

n = n + 1 : b(n, 1) = a(i, 1) : .add a(i, 1), n

 

[JNagelvoort]

Peter SSs,
You are very clear on this. It does not matter if the column A text remains or is emptied. As long as any unselected cells are not effected. So, as in your example "Rearrange (3)", it does not matter if cells A8 and A9 contains the name "Bill" or not after running the macro as long as cells F6:IV9 are not changed.
Your example in Rearrange (5) is perfect. And again removing or not removing the name "Alex" from cell A4 is optional.

Jon

 

[JNagelvoort]

jidon,
Thank you, but not what I had in mind. Need the macro to work on only cell and data within a selected area and not effect the complete spreadsheet.
Thank you for your effort.
Jon

 

[Peter_SSs]

Peter SSs,
You are very clear on this. It does not matter if the column A text remains or is emptied. As long as any unselected cells are not effected. So, as in your example "Rearrange (3)", it does not matter if cells A8 and A9 contains the name "Bill" or not after running the macro as long as cells F6:IV9 are not changed.
Your example in Rearrange (5) is perfect. And again removing or not removing the name "Alex" from cell A4 is optional.

Jon

Sorry, I may not be able to put much time to this for a couple of days. I'll post something as soon as I can though.

 

[jindon]

Back up 1st and see if this works for you.

Sub test()
Dim a, i As Long, ii As Long, w(), n As Long, e
With Selection
    a = .Value
    .ClearContents
End With
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
        If Not .exists(a(i, 1)) Then
            ReDim w(1 To UBound(a, 2), 1 To 1)
            For ii = 1 To UBound(a, 2) : w(ii, 1) = a(i, ii) : Next
            .add a(i, 1), w
        Else
            w = .item(a(i, 1))
            For ii = 2 To UBound(a, 2)
                If a(i, ii) <> "" Then
                    For iii = 1 To UBound(w, 1)
                        If w(ii, iii) <> "" Then
                            w(ii, iii) = a(i, ii) : flg = True : Exit For
                        End If
                    Next
                    If Not flg Then
                        ReDim Preserve w(1 To UBound(a, 2), 1 To UBound(w, 2) + 1))
                        w(1, UBound(w, 2)) = a(i, 1)
                        w(ii, UBound(w, 2)) = a(i, ii)
                    End If
                    flg = False
                End If
            Next
            .item(a(i, 1)) = w
        End If
    Next
    For Each e In .items
        Selection.Cells(1).Offset(n).Resize(UBound(e, 2), UBound(e, 1)).Value = _
        Application.Transpose(e)
        n = n + UBound(e, 2)
    Next
End With
End Sub