Sort All Sheets In Workbook

[Logit]

This code works very well for one sheet. I would like to modify it so it affects all sheets in a workbook. After trying several attempts at creating an array of sheets I'm frustrated.

Any suggestions ? Thank You.


Option Explicit

Dim UnSortedArray As Variant

Sub test()
Dim i As Long, j As Long, temp As Variant
Dim Pivot As Long, PivotPlace As Long
Dim rowLow As Long, rowHigh As Long
Dim colLow As Long, colHigh As Long
Dim Descending As Boolean
Dim Low As Long, High As Long
Dim Stack() As Long, StackPointer As Long
Dim rowArray() As Long, sortedArray As Variant
Dim Descending As Boolean

Descending = False: 'Rem Set As desired
ReDim Stack(1 To 2, 0 To 0)

'Rem get unsorted array, adjust
With Sheet1.Range("A:A")
UnSortedArray = Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(1, 4)).Value
End With

rowLow = LBound(UnSortedArray, 1)
rowHigh = UBound(UnSortedArray, 1)
colLow = LBound(UnSortedArray, 2)
colHigh = UBound(UnSortedArray, 2)

'Rem make array of row numbers
ReDim rowArray(rowLow To rowHigh)
For i = rowLow To rowHigh
rowArray(i) = i
Next i

'Rem sort array of row numbers ordered by unsortedArray values In LT Function

Low = rowLow: High = rowHigh
GoSub Push

Do Until StackPointer <= 0
GoSub Pop

'Rem pivot choosing
i = (Low + High) / 2
temp = rowArray(i)
rowArray(i) = rowArray(High)
rowArray(High) = temp


Pivot = rowArray(High)
PivotPlace = Low

For i = Low To High - 1
If LT(rowArray(i), Pivot, Descending) Then
temp = rowArray(i)
rowArray(i) = rowArray(PivotPlace)
rowArray(PivotPlace) = temp
PivotPlace = PivotPlace + 1
End If
Next i

rowArray(High) = rowArray(PivotPlace)
rowArray(PivotPlace) = Pivot
i = Low: j = High

If Low < PivotPlace Then
High = PivotPlace - 1
GoSub Push
End If

If PivotPlace < j Then
High = j
Low = PivotPlace + 1
GoSub Push
End If
Loop

'Rem convert sorted array of row numbers into sortedArray
sortedArray = UnSortedArray
For i = rowLow To rowHigh
For j = colLow To colHigh
sortedArray(i, j) = UnSortedArray(rowArray(i), j)
Next j
Next i

'Rem adjust Output
Range("I1").Resize(rowHigh, colHigh).Value = sortedArray

Exit Sub
Push:
StackPointer = StackPointer + 1
If UBound(Stack, 2) < StackPointer Then ReDim Preserve Stack(1 To 2, 0 To 2 * StackPointer)
Stack(1, StackPointer) = Low
Stack(2, StackPointer) = High
Return
Pop:
Low = Stack(1, StackPointer)
High = Stack(2, StackPointer)
StackPointer = StackPointer - 1
Return
End Sub

Function LT(a As Long, b As Long, Optional Descending As Boolean = False) As Boolean
Dim col1 As Long, col2 As Long, col3 As Long
col1 = 1
col2 = 2
col3 = 3
'Rem nullString Is GT everything
If UnSortedArray(a, col1) = vbNullString Then
LT = False
ElseIf UnSortedArray(b, col1) = vbNullString Then
LT = True
ElseIf (UnSortedArray(a, col1) < UnSortedArray(b, col1)) Then
LT = True Xor Descending
ElseIf (UnSortedArray(b, col1) < UnSortedArray(a, col1)) Then
LT = False Xor Descending
Else
If UnSortedArray(a, col2) < UnSortedArray(b, col2) Then
LT = True Xor Descending
ElseIf UnSortedArray(b, col2) < UnSortedArray(a, col2) Then
LT = False Xor Descending
Else
LT = (UnSortedArray(a, col3) < UnSortedArray(b, col3)) Xor Descending
End If
End If
End Function

[mikerickson]

That looks like my code.

To make it loop through all the sheets of a workbook, the easiest way is to pass the sheet as an argument to the Test Function, changing some of the references in the Test sub. Leave the LT function alone. And leave the UnsorteArray module wide variable as is.



Dim UnSortedArray As Variant

Sub test(aSheet as Worksheet)
' .....

With aSheet.Range("A:A")
UnSortedArray = Range(.Cells(Rows.Count, 1).End(xlUp), .Cells(1, 4)).Value
End With

' ....

aSheet.Range("I1").Resize(rowHigh, colHigh).Value = sortedArray

Exit Sub
Push:
'....
Pop:
'....
End Sub

And then write a Master routine that calls it repeatedly


Sub Master()
Dim oneSheet As Worksheet

For Each oneSheet in ThisWorkbook.Worksheets
Call Test(oneSheet)
Next oneSheet
End Sub

[Logit]

Not certain where I found it .... could very well be your code. Thank you ! :trophy:

Let me give this a try.

[Logit]

Thank you so much !

One more question please, if you don't mind ...

If I wanted to specify sorting only two separate columns ( say ... A & C ... or G & Z ... just different columns) ... how would I edit this
With aSheet.Range("A:A")

My first thought was to use
With aSheet.Range("A", "C") but of course that didn't work. Also tried a few variations of the same.

???

[mikerickson]

What do you mean "sort two different columns"

That code sorts A:D based on the value in column A with Column B being the first tie-breaker and C the next.

Do you want A to be sorted and C to be sorted, but the values in B and D left alone.


Or are you talking about using different columns (other than A, B, C) to determine the sort of all the cells?

[snb]

Why don't you use Excel's builtin sorting routine ?


Sub M_snb()
for each it in sheets
it.cells(1,1).currentregion.sort it.cells(1,1),,it.cells(1,3)
next
End Sub

[Logit]

Data located in Col A & Col C to be sorted.

There may or may not be data in Col B.

Select two random columns with no attention paid to data located in Columns in-between.

Hope this is understandable ...


ps: Using the built in sorting is always available but getting VBA to accomplish the goal is interesting and challenging. :yes

[mikerickson]

When you want to sort these two columns, do you want them sorted independently or linked, i.e. if two of these cells start on the same row do you want them to the on the same row of the result?

[snb]

In that case you'd better use 'Arraylist' or 'sortedlist'.

[Logit]

"do you want them sorted independently" Yes

[Paul_Hossler]

I think it's faster to use the built in sort




Option Explicit

Sub Macro1()

Dim ws As Worksheet
Dim iCol As Long

For Each ws In ActiveWorkbook.Worksheets
For iCol = 1 To 3 Step 2
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=Range(ws.Cells(2, iCol), ws.Cells(2, iCol).End(xlDown)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(ws.Cells(1, iCol), ws.Cells(1, iCol).End(xlDown))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next iCol
Next
End Sub

[Logit]

Thanks Paul. Merry Christmas !

Stay warm .... brrrr

[Logit]

Wow ! That's a new one. The Forum tools won't let me give out Add Reps. !!!!!!

Merry Christmas ????

Bah ! Hum Bug !!


!!! THANK YOU MIKE RICKSON !!!