vanhunk
09-26-2014, 07:25 AM
Sorting Code needs simplification:
Dear all,
This macro sorts the data in columns B to K according to the date. Dates are in column B. Data starts in row 7 and row 6 has headings The data is in blocks representing months.
Each month has a header or footer row with the first cell the first day of the month with a green background.
It is possible to have a data row for the first day of the month. With the original code, when this is the case, the header row ends up between rows for the same month. This is not acceptable and hence the new code. I would like to simplify the new code. I tried a number of things, but did not succeed.
Please help.
Regards,
vanhunk
Sub OriginalSortingCode()
Dim LaasteCell As Range
Set LaasteCell = Range("B6000").End(xlUp)
Range("B6", Cells(LaasteCell.Row, "K")).Select
Selection.Sort Key1:=Range("B7"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Reference:="'Summary'!R1C1", Scroll:=True
End Sub
New Macro that needs simplification:
Sub NewSortingMacro()
'This macro sorts the data in columns B to K according to the date. Dates are in column B. Data starts in row 7 and row 6 has headings The data is in blocks representing months.
'Each month has a header or footer row with the first cell the first day of the month with a green background.
'It is possible to have a data row for the first day of the month and to prevent the header/footer row to separate this row from the other rows for the same month, I used another criteria, i.e. background colour.
Dim LaasteCell As Range
Set LaasteCell = Range("B6000").End(xlUp)
Range("B6", Cells(LaasteCell.Row, "K")).Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B6"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B6"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Selection
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Application.Goto Reference:="'Summary'!R1C1", Scroll:=True
End Sub
Dear all,
This macro sorts the data in columns B to K according to the date. Dates are in column B. Data starts in row 7 and row 6 has headings The data is in blocks representing months.
Each month has a header or footer row with the first cell the first day of the month with a green background.
It is possible to have a data row for the first day of the month. With the original code, when this is the case, the header row ends up between rows for the same month. This is not acceptable and hence the new code. I would like to simplify the new code. I tried a number of things, but did not succeed.
Please help.
Regards,
vanhunk
Sub OriginalSortingCode()
Dim LaasteCell As Range
Set LaasteCell = Range("B6000").End(xlUp)
Range("B6", Cells(LaasteCell.Row, "K")).Select
Selection.Sort Key1:=Range("B7"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.Goto Reference:="'Summary'!R1C1", Scroll:=True
End Sub
New Macro that needs simplification:
Sub NewSortingMacro()
'This macro sorts the data in columns B to K according to the date. Dates are in column B. Data starts in row 7 and row 6 has headings The data is in blocks representing months.
'Each month has a header or footer row with the first cell the first day of the month with a green background.
'It is possible to have a data row for the first day of the month and to prevent the header/footer row to separate this row from the other rows for the same month, I used another criteria, i.e. background colour.
Dim LaasteCell As Range
Set LaasteCell = Range("B6000").End(xlUp)
Range("B6", Cells(LaasteCell.Row, "K")).Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B6"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("B6"), SortOn:=xlSortOnCellColor, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Selection
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Application.Goto Reference:="'Summary'!R1C1", Scroll:=True
End Sub