View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.misc
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Inconsistent Sorting

Or you could just do all the sorts at once:

Option Explicit
Sub testme()
Dim myRngToSort As Range
Dim myBigRng As Range
Dim myPiecesRng As Range
Dim myArea As Range
Dim wks As Worksheet
Dim TotalColsToSort As Long
Dim KeyCol1 As Variant
Dim KeyCol2 As Variant
Dim KeyCol3 As Variant
Dim ColThatGetsRanked As Variant
Dim iCtr As Long

Set wks = Worksheets("sheet1")

With wks

'fix this part to sort what you want and by what you want
TotalColsToSort = 20
KeyCol1 = Array(10, 11, 12)
KeyCol2 = Array(11, 12, 13)
KeyCol3 = Array(1, 1, 1)

'fix this part to add the rankings to the correct columns
ColThatGetsRanked = Array(14, 15, 16)

Set myBigRng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))

Set myPiecesRng = Nothing
On Error Resume Next
Set myPiecesRng = myBigRng.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If myPiecesRng Is Nothing Then
MsgBox "No constants in column A!"
Exit Sub
End If

For Each myArea In myPiecesRng.Areas
With myArea
'come down 2 rows to avoid the headings
Set myRngToSort _
= .Resize(.Rows.Count - 2, TotalColsToSort).Offset(2, 0)

For iCtr = LBound(KeyCol1) To UBound(KeyCol1)
myRngToSort.Sort _
key1:=.Columns(KeyCol1(iCtr)), order1:=xlDescending, _
key2:=.Columns(KeyCol2(iCtr)), order1:=xlDescending, _
key3:=.Columns(KeyCol3(iCtr)), order1:=xlDescending, _
header:=xlNo
With myRngToSort.Resize(, 1) _
.Offset(0, ColThatGetsRanked(iCtr) - 1)
.Formula = "=row()+1-" & myRngToSort.Row
.Value = .Value
End With
Next iCtr
End With
Next myArea
End With

End Sub

Dave Peterson wrote:

You can make additional macros.

This will be the area you want to change:

TotalColsToSort = 12
KeyCol1 = 10 'column j
KeyCol2 = 11 'column k
KeyCol3 = 1 'column A
ColThatGetsRanked = .Range("n1").Column

Saxman wrote:

Dave Peterson wrote:
How about:

Option Explicit
Sub testme()
Dim myRngToSort As Range
Dim myBigRng As Range
Dim myPiecesRng As Range
Dim myArea As Range
Dim wks As Worksheet
Dim TotalColsToSort As Long
Dim KeyCol1 As Long
Dim KeyCol2 As Long
Dim KeyCol3 As Long
Dim ColThatGetsRanked As Long


That is perfect! It sorts column 'J' and fills down in column 'N' in
batches.

After I have run the above, how can I get it to sort column 'K' and
filldown in column 'O' and then sort column 'L' and filldown in column
'P' similarly?


--

Dave Peterson


--

Dave Peterson