Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default 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
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,494
Default 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



  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,494
Default 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



  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 2,494
Default 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



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Is there an option to view Special (control) Characters in Excel 2 schackbo Excel Discussion (Misc queries) 3 December 21st 09 01:18 AM
data, sort option is grayed. how to sort on a column? Steve Richter Excel Discussion (Misc queries) 1 September 25th 07 03:25 PM
Special Sort Help James E Middleton Excel Discussion (Misc queries) 2 March 6th 07 09:42 AM
the transpose option does show when I rightclick special paste Marilyn Mac Excel Discussion (Misc queries) 0 June 7th 06 08:13 PM
Excel 2003 - paste special option Robert K Excel Worksheet Functions 1 February 4th 06 10:40 PM


All times are GMT +1. The time now is 11:44 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"