Repeat Sort Macro for Paired Rows Down Entire Sheet

[Tallonenx]

Hi all, trying to sort dates and events on those dates which are in two rows like so:

4/2/2016	6/3/2016			7/7/2015			1/2/2016	6/6/2016	6/15/2016
				AAA				CCC

<tbody>
</tbody>

These rows continue for hundreds of columns, and there are hundreds of row pairings themselves.
Some of the dates have events, others are blanks.
There are some blanks between dates as well.

>Selecting two rows together at a time sorts the row pairs together and keeps the second row events together with their corresponding date.
No problem with empties or anything- Easy enough.

IE the Sort Yields:

7/7/2015	1/2/2016	4/2/2016	6/3/2016	6/6/2016	6/15/2016
AAA				CCC

<tbody>
</tbody>

My question is- how can I automate this two row a piece simple sorting down the entire selection of data/or sheet,
instead of having to select each set of two rows manually?


I tried recording a macro but found I'd have to manually change the selections in it too ex:

Sub TestOrder()
'
' TestOrder Macro
'

'
    Rows("1:2").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1:NU1") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:NU2")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("3:4").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A3:NU3") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A3:NU4")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("5:6").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A5:NU5") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A5:NU6")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

I suppose the solution would be to get rid of the select code and do some looping, but I can't get it to work.
Any help is MUCH appreciated!

 

[Fluff]

Using the data you showed in your op. This is what I get.
1st 2 rows final result
2nd 2rows intermediate result
final 2 rows original data
If you are not getting this, or your data does not look like this. Could you please supply a more representative sample.

Excel 2013 32 bit
	A	B	C	D	E	F	G	H	I	J	K
1	07/07/2015	01/02/2016	04/02/2016	06/03/2016	06/06/2016	6/15/2016
2	AAA				CCC
3
4	07/07/2015	07/07/2015	01/02/2016	04/02/2016	06/03/2016	06/06/2016	06/06/2016	6/15/2016
5		AAA					CCC
6
7	04/02/2016	06/03/2016		07/07/2015	07/07/2015			01/02/2016	06/06/2016	06/06/2016	6/15/2016
8					AAA					CCC
Summary

 

[Marcelo Branco]

Hi Dave

Your code failed with this scenario - duplicated to be deleted (blank in the row below) after the first occurrence
Dates as dd/mm/yyyy

	A​	B​	C​	D​	E​	F​	G​	H​	I​	J​	K​
1​	04/02/2016​	06/03/2016​		07/07/2015​	07/07/2015​			01/02/2016​	06/06/2016​	06/06/2016​	15/06/2016​
2​	AAA​			AAA​						CCC​

<tbody>
</tbody>

It seems my last code (post 10) is working fine. Waiting for the OP...

M.

 

[Fluff]

Hello Marcelo
I'd agree that your solution is more robust than mine & would recommend the OP to use it.
As the OP said that the duplicate dates were always in front of those with events, then mine solution should work as well.
We'll see what the OP has to say.

 

[Tallonenx]

Great!
Marcelo's code clears the correct cells now..
but leaves the cleared cells as blanks.


I tried to F5 Special --> Delete Blanks, but it deletes all the blanks in the sheet, which won't work.

Somehow the duplicate blanks, and the corresponding row below them, need to be deleted and shifted (to the left?).


Is there a way to do this automated?
Could the code above be used to do this- IE instead of clearing
could it delete and shift to the left the duplicate date and the row below it?

Again, thank you both!

 

[Marcelo Branco]

Great!
Marcelo's code clears the correct cells now..
but leaves the cleared cells as blanks.

I thought that it's what you wanted. If not, please provide more examples with desired outcomes.

M.

 

[Tallonenx]

Ok. Thanks Marcelo.

The code clears the cells but does not delete them.

Ex- Current Code Does this:

1/1/2016	1/2/2016	1/2/2016	1/3/2016	1/4/2016
	AAA

<tbody>
</tbody>

-->

1/1/2016	1/2/2016	[Blank]	1/3/2016	1/4/2016
	AAA

<tbody>
</tbody>

Ideally It Would do This:

1/1/2016	1/2/2016	1/2/2016	1/3/2016	1/4/2016
	AAA

<tbody>
</tbody>

-->

1/1/2016	1/2/2016	1/3/2016	1/4/2016
	AAA

<tbody>
</tbody>

No Blanks left, but bottom row still corresponding to its respective date.

 

[Marcelo Branco]

For me the code (post 10) worked perfectly

Before macro

	A​	B​	C​	D​	E​
1​	01/01/2016​	01/02/2016​	01/02/2016​	01/03/2016​	01/04/2016​
2​		AAA​

<tbody>
</tbody>

Macro

Sub HorizontalSort()
    Dim rData As Range, i As Long, rCell As Range
    
    Set rData = Range("A1:E2") '<--adjust to suit
    For i = 1 To rData.Rows.Count Step 2
        With rData.Rows(i)
            For Each rCell In .Cells
                If Application.CountIf(.Cells, rCell.Value) > 1 And rCell.Offset(1) = "" Then rCell.ClearContents
            Next rCell
        End With
    
        With Range("A" & i & ":J" & i + 1)
            .Sort key1:=.Cells(1), Orientation:=xlSortRows, Header:=xlNo
        End With
    Next i
End Sub

After macro

	A​	B​	C​	D​
1​	01/01/2016​	01/02/2016​	01/03/2016​	01/04/2016​
2​		AAA​

<tbody>
</tbody>

M.