it was late so i took the easy way to sort the data. this one doesn't need a
sheet to do the sorting, so as long as your data starts is a1, it should work.

Option Explicit
Sub Macro2()
Dim ws As Worksheet
Dim lastcol As Long
Dim lastrow As Long
Dim x As Long, z As Long, w As Long, y As Long
Dim i As Long, n As Long, k As Long, j As Long
Dim temp0 As String, temp1 As Long
Dim arr() As Variant
Dim arr2() As Variant
Dim arr3() As Variant
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

For x = 2 To lastrow Step 3
ReDim Preserve arr(0 To z)
arr(z) = ws.Range("A" & x - 1 & ":" & Cells(x, lastcol).Address)
z = z + 1
Next
z = 0

For i = LBound(arr) To UBound(arr)
ReDim Preserve arr2(0 To z)
ReDim Preserve arr3(0 To z)
arr2(z) = arr(i)(2, lastcol)
arr3(z) = arr(i)(1, 1)
z = z + 1
Next i
y = 1

'sort the array
For i = LBound(arr2) To UBound(arr2) - 1
For j = i + 1 To UBound(arr)
If arr2(i) < arr2(j) Then
temp0 = arr3(j)
temp1 = arr2(j)

arr3(j) = arr3(i)
arr2(j) = arr2(i)

arr3(i) = temp0
arr2(i) = temp1
End If
Next j
Next i

For w = LBound(arr3) To UBound(arr3)
Do While arr3(w) < arr(n)(1, 1)
n = n + 1
Loop
ws.Range("A1:" & Cells(2, lastcol).Address).Offset(k) = arr(n)
ws.Cells(2, lastcol).Offset(k).Formula = "=sum(" & _
ws.Range("B2").Offset(k).Address(0, 0) & ":" & ws.Cells(2, lastcol _
- 1).Offset(k).Address(0, 0) & ")"
k = k + 3
n = 0
Next
End Sub

--


Gary


"Owens2125" wrote in message
...
I have a workbook containing several scores for different teams. How can I
sort the total scores for each team by highest to lowest while still keeping
all the other team info with it?

Ex.
Team 1 Day 1 Day 2 Total
Bluejays 46 44 90

Team 2 Day 1 Day 2 Total
Cardinals 43 49 92