This is what I have come up with. Its sorts HYPER but not the other 2
Sub Quotelist()
'
' Quotelist Macro
' Macro recorded 13/07/2006 by terminal12
'

'

Dim cell As Range, rng As Range
Dim max1 As Long, max2 As Long, max3 As Long
Dim min1 As Long, min2 As Long, min3 As Long
min1 = 65536
min2 = 65536
min3 = 65536
Columns("B:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Delete Shift:=xlToLeft
Columns("G:K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").ColumnWidth = 18.71
Range("B1").Select
Columns("A:A").ColumnWidth = 22.71
Columns("C:C").ColumnWidth = 14.29
Columns("G:G").ColumnWidth = 12.57
Range("A1").CurrentRegion.Sort _
Key1:=Range("F2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("O7").FormulaR1C1 = "AA Total"
Range("O8").FormulaR1C1 = "PR Total"
Range("O9").FormulaR1C1 = "HY Total"
Set rng = Range(Range("F2"), _
Cells(Rows.Count, "F").End(xlUp))
For Each cell In rng
Select Case Trim(cell.Value)
Case "ALLEN"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row max1 Then max1 = cell.Row
Case " ALLEN"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row max1 Then max1 = cell.Row
Case " ALLEN"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row max1 Then max1 = cell.Row
Case " PREST"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row max1 Then max1 = cell.Row
Case " PREST"
If cell.Row < min1 Then min1 = cell.Row
If cell.Row max1 Then max1 = cell.Row
Case "PREST"
If cell.Row < min2 Then min2 = cell.Row
If cell.Row max2 Then max2 = cell.Row
Case "HYPER"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
Case " HYPER"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
Case " HYPER"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
Case "PRESTIGE"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
Case " PRESTIGE"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
Case " PRESTIGE"
If cell.Row < min3 Then min3 = cell.Row
If cell.Row max3 Then max3 = cell.Row
End Select
Next
Range("P7").FormulaR1C1 = _
"=SUM(R" & min1 & "C4:R" & max1 & "C4)"
Range("P8").FormulaR1C1 = _
"=SUM(R" & min2 & "C4:R" & max2 & "C4)"
Range("P9").FormulaR1C1 = _
"=SUM(R" & min3 & "C4:R" & max3 & "C4)"

End Sub



Regards

Barry