special sort option
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 |
special sort option
send me your email address and i'll send you something to try.
-- 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 |
special sort option
i'll try and post this and hope it doesn't wrap.
i assumed the data started in A1 on sheet1 and use sheet3 to do a sort. if this is not the case or you don't have a sheet3, then it will have to be modified. Option Explicit Sub Macro1() 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 Dim arr() As Variant Dim arr2() As Variant Dim arr3() As Variant Dim cell As Range Dim lastrow3 As Long Dim ws3 As Worksheet Set ws = Worksheets("Sheet1") Set ws3 = Worksheets("Sheet3") 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 For w = LBound(arr) To UBound(arr) ws3.Range("A" & w + 1).Value = arr(w)(1, 1) ws3.Range("B" & w + 1).Value = Application.Max(arr(w)) Next With ws3.Columns("A:B") .Sort Key1:=.Range("B1"), Order1:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, _ MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal End With lastrow3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row For Each cell In ws3.Range("A1:A" & lastrow3) Do While cell.Value < 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 & ":" & ws.Cells(2, lastcol - _ 1).Offset(k).Address & ")" k = k + 3 n = 0 Next ws3.Cells.Clear 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 |
special sort option
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 |
All times are GMT +1. The time now is 03:37 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com