Complicated sort using VBA

[MrOllyR]

Hi, everyone

I'm trying to automate a sort function using VBA. I'm looking at student scores and I'm trying to create class groups based on scores while keeping ages within 4 years.

Here's the spreadsheet: Sort range.xlsm
It's a link to Google Drive as I'm using a work computer:

I have managed to create the initial sort in this order: Grade 4, Grade 3, Grade 2, Grade 1. The macro includes whole columns as I want to be able to use it with different data sets:

Sub Sort()

Columns("A:H").Select
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("H:H") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("G:G") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("F:F") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Data").Sort.SortFields.Add2 Key:=Range("E:E") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Data").Sort
.SetRange Range("A:H")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

From here, I want to find the lowest number in column H and find the next half number in column H, e.g. if the first number in column H is "0.5" the next number would be "1.". In this instance, the lowest number is "0" and the next number is "0.5".

With the data range A2:H10 (everyone in this range has a score in column H of "0" to "0.5"), I would like to sort this data by: Age, Grade 4, Grade 3, Grade 2, and Grade 1.

From then I want to repeat the process above but starting from the next row. In this instance it's students with a score in column H with "1" to "1.5". This would be range A11:A24. Again, I would like to sort this data by: Age, Grade 4, Grade 3, Grade 2, and Grade 1.

I want it to repeat this process through the rest of the data, sorting by Age, Grade 4, Grade 3, Grade 2, and Grade 1.

Can anyone help?

Thank you in advance.

 

[BSALV]

Sub Sort()
     Dim c     As Range
     With Sheets("Data")
          Set c0 = .Range("a1").CurrentRegion
          c0.AutoFilter
          If c0.Rows.Count <= 1 Then MsgBox "sorry...": Exit Sub
          With .Sort
               .SortFields.Clear
               .SortFields.Add2 Key:=c0.Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SetRange c0
               .Header = xlYes
               .MatchCase = False
               .Orientation = xlTopToBottom
               .SortMethod = xlPinYin
               .Apply
          End With

          mymin = Application.Min(c0.Columns("H"))
          mymax = Application.Max(c0.Columns("H").Value)
          For i = mymin To mymax
               c0.AutoFilter 8, ">=" & i, xlAnd, "<" & i + 1
               On Error Resume Next
               Set c = Intersect(c0.Offset(1), c0.SpecialCells(xlVisible))
               On Error GoTo 0
               If Not c Is Nothing Then
                    MsgBox c.Address
                    With .Sort
                         .SortFields.Clear
                         .SortFields.Add2 Key:=c.Columns("C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SetRange c
                         .Header = xlNo
                         .MatchCase = False
                         .Orientation = xlTopToBottom
                         .SortMethod = xlPinYin
                         .Apply
                    End With
               End If
          Next
          c0.AutoFilter
     End With
End Sub

 

[MrOllyR]

Sub Sort()
     Dim c     As Range
     With Sheets("Data")
          Set c0 = .Range("a1").CurrentRegion
          c0.AutoFilter
          If c0.Rows.Count <= 1 Then MsgBox "sorry...": Exit Sub
          With .Sort
               .SortFields.Clear
               .SortFields.Add2 Key:=c0.Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SortFields.Add2 Key:=c0.Columns("E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
               .SetRange c0
               .Header = xlYes
               .MatchCase = False
               .Orientation = xlTopToBottom
               .SortMethod = xlPinYin
               .Apply
          End With

          mymin = Application.Min(c0.Columns("H"))
          mymax = Application.Max(c0.Columns("H").Value)
          For i = mymin To mymax
               c0.AutoFilter 8, ">=" & i, xlAnd, "<" & i + 1
               On Error Resume Next
               Set c = Intersect(c0.Offset(1), c0.SpecialCells(xlVisible))
               On Error GoTo 0
               If Not c Is Nothing Then
                    MsgBox c.Address
                    With .Sort
                         .SortFields.Clear
                         .SortFields.Add2 Key:=c.Columns("C"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("H"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("F"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SortFields.Add2 Key:=c.Columns("E"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                         .SetRange c
                         .Header = xlNo
                         .MatchCase = False
                         .Orientation = xlTopToBottom
                         .SortMethod = xlPinYin
                         .Apply
                    End With
               End If
          Next
          c0.AutoFilter
     End With
End Sub

Thank you, this is much appreciated! If I wanted to restrict the parameters in column H- at the moment it's set to 1, i.e. sort grades 0-0.5; grades 1-1.5, etc.
Would I change this: c0.AutoFilter 8, ">=" & i, xlAnd, "<" & i + 1
If I change the last number to 0.5, would that narrow the parameters?

 

[BSALV]

i suppose the points are multiples of 0.5, there 'll be nothing like a 0.3 ???
Then you can use a step of 0.5 in the for...next loop and an exact match

For i = mymin To mymax step 0.5
               c0.AutoFilter 8, "=" & i

 

[MrOllyR]

i suppose the points are multiples of 0.5, there 'll be nothing like a 0.3 ???
Then you can use a step of 0.5 in the for...next loop and an exact match

For i = mymin To mymax step 0.5
               c0.AutoFilter 8, "=" & i

Thank you!