sorting in VBA

[wibni]

Hello,

Below is my table I try to sort in VBA.
Column A are months and must not change.
Column B,C and D need to be sorted so that "Site" in Column B always comes on top.
There will only ever be "Office" or "Site" in column B but I'm having difficulties in finding a way to sort it by month name.

Would anyone here please be able to give me an idea on how to sort my table?

Excel Workbook
	A	B	C	D
1	January	Site	GGM	6
2	January	Site	NMM	5
3	January	Office	MWA	11
4	January	Office	KNC	11
5	February	Site	GGM	7
6	February	Site	NMM	5
7	February	Office	MWA	12
8	February	Office	KNC	12
9	March	Site	GGM	7
10	March	Site	NMM	5
11	March	Office	MWA	12
12	March	Office	KNC	12
13	April	Site	GGM	6
14	April	Site	NMM	7
15	April	Office	MWA	13
16	April	Office	KNC	13
Sheet1

 

[Noz2k]

This is what I got from the macro recorder, would think it can be neatened up, but think it does what you want

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2:B16") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "January,February,March,April,May,June,July,August,September,October,November,December" _
        , DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C2:C16") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B1:E16")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Obviously you'll need to change the sheet name and range to match your requirements

 

[VoG]

Try

Sub ASort()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR - 3 Step 4
    Range("B" & i).Resize(4, 3).Sort Key1:=Range("B" & i), Order1:=xlDescending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next i
End Sub

 

[wibni]

Thanks for your replies.

VoG - How would I make the 'Step 4' in your code dynamic since the rows for each month are not always 4. They can be more or less 4.

I guess I need to have a counter for the number of rows per month somehow.


Noz2k - I tried that with the macro code as well but it sorts the whole range and not for every month.

 

[VoG]

Try this

Sub ASort()
Dim LR As Long, i As Long, x As Long
x = Application.InputBox("Enter number of rows per month", Type:=1)
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR - (x - 1) Step x
    Range("B" & i).Resize(x, 3).Sort Key1:=Range("B" & i), Order1:=xlDescending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next i
End Sub

 

[wibni]

Yeah, thats a good idea that works but I can't have input boxes.
Can I somehow count the rows per month and use this in the sort?

 

[VoG]

Try

Sub ASort()
Dim LR As Long, i As Long, x As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If Range("A" & i).Value <> Range("A" & i + 1).Value Then
        x = i
        Exit For
    End If
Next i
For i = 1 To LR - (x - 1) Step x
    Range("B" & i).Resize(x, 3).Sort Key1:=Range("B" & i), Order1:=xlDescending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next i
End Sub

 

[wibni]

Thank you very much!

I've done it now like the below and it seems towork ok.

LR = Range("A1").End(xlDown).Row
    x = 1
    SortStartRow = 1
    
    For i = x To LR
        If Range("A" & i).Value <> Range("A" & i + 1).Value Then
            Range("B" & SortStartRow).Resize(x, 13).Sort Key1:=Range("B" & SortStartRow), Order1:=xlDescending, _
            Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
            SortStartRow = i + 1
            x = 1
        Else
            x = x + 1
        End If
    Next i