Logit
12-18-2016, 05:54 PM
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
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