YouTube, Video making and editing, etc. coupled to excelfox ( windows Movie Maker )

Test Sort Routine

test post in support of this forum question
http://www.eileenslounge.com/viewtop...245488#p245485

Yellow is effectively the array fed to a sort routine.
Green is how that array looks like after running the sort routine

_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )

2

10

8

2

16

8

1

10

15

2

8

1

10

15

2

19

6

3

14

13

15

15

10

6

13

13

7

6

15

16

2

17

2

8

3

5

9

11

12

8

15

12

15

4

5

2

10

8

2

16

13

13

6

4

11

15

12

15

4

5

19

6

3

14

13

13

13

6

4

11

5

9

11

12

8

15

15

10

6

13

14

18

18

16

20

2

17

2

8

3

13

7

6

15

16

14

18

18

16

20

Worksheet: Sheet1

_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )

14

2

2.9986

17

1

1.9983

15

6

6.9985

19

1

1.9981

16

3

3.9984

20

1

1.998

17

1

1.9983

14

2

2.9986

18

2

2.9982

18

2

2.9982

19

1

1.9981

16

3

3.9984

20

1

1.998

15

6

6.9985

Worksheet: Sheet1

_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )

15

4

5

15

4

5

6

4

11

6

4

11

3

14

13

3

14

13

Worksheet: Sheet1

Test calling routine : ( called routines in next 2 posts )

Code:

Sub TestsStringArray() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=31691&p=245488#p245488 Dim arrSel() As Variant Let arrSel() = Selection.Value Dim DumDom() As String: ReDim DumDom(0 To UBound(arrSel(), 1) - 1, 0 To UBound(arrSel(), 2) - 1) Dim rCnt As Long, cCnt As Long For rCnt = 0 To UBound(arrSel(), 1) - 1 For cCnt = 0 To UBound(arrSel(), 2) - 1 Let DumDom(rCnt, cCnt) = CStr(arrSel(rCnt + 1, cCnt + 1)) Next cCnt Next rCnt Call subSort2DArrayMultiElements(DumDom(), "1 2") ' Paste reorganised Array next to the selection Dim OutRange As Range: Set OutRange = Selection.Offset(0, Selection.Columns.Count) Let OutRange.Value = DumDom() End Sub

_____ Workbook: YassBub.xlsm ( Using Excel 2007 32 bit )

Sub

sub

d

Sub

func

h

Sub

func

h

Pub

pub

a

sub

pub

x

func

pub

m

func

pub

m

Pub

pub

p

func

pub

r

func

pub

r

Pub

pub

a

sub

pub

x

Pub

pub

p

Sub

sub

d

Worksheet: Sheet1

Routines called by test code , Sub TestsStringArray() , in last post:

Code:

Sub subSort2DArrayMultiElements( _ sparray() As String, _ spOrder As String _ ) ' Sort an array with TWO dimensions. ' Assume Sort on the 2nd Dimension ' so assumes it IS a 2 Dim array. ' Sort on more than one element. ' ' This uses a merge sort. ' The sort is set up as ascending and not case sensitive. ' ' Use ' subSortMultiElements Array, Order ' ' Ex Order = "1 4 0 3 2". ' Not all elements need be specified. ' Any delimiter may be used. ' Dim lnglArrayIndex As Long Dim lnglElements As Long Dim lnglEndArray As Long Dim lnglKey As Long Dim lnglLbound As Long Dim lnglM As Long Dim lnglN As Long Dim lnglNumSortKeys As Long Dim lnglO As Long Dim lnglP As Long Dim lnglPrevKeyCol As Long Dim lnglThisKeyCol As Long Dim lnglUBound As Long Dim lngSubArrayRows As Long Dim slKeyVal As String Dim slOrder As String Dim slOrderArray() As String Dim slSubArray() As String Dim slTopKeyVal As String lnglElements = UBound(sparray, 2) ' Make an Order Array. slOrder = spOrder ' Delimiter? ' Disappear the numbers. For lnglN = 0 To 9 slOrder = Replace(slOrder, CStr(lnglN), "") Next lnglN slOrder = Trim$(slOrder) ' Should only have the delimiter left. If Len(slOrder) = 0 Then slOrderArray = Split(spOrder, " ") Else slOrderArray = Split(spOrder, Mid$(slOrder, 1, 1)) End If lnglNumSortKeys = UBound(slOrderArray) + 1 ' Always Sort on the FIRST Key. lnglKey = CLng(slOrderArray(0)) subArrayMergeSort sparray, lnglKey ' Only one key? If lnglNumSortKeys = 1 Then Exit Sub End If ' Now go through the rest of the keys. ' We extract a series of arrays based on the KEY - 1. ' Any records to sort? If UBound(slOrderArray) > 0 Then For lnglN = 1 To lnglNumSortKeys - 1 ' Pick up the start Value from Key-1. lnglPrevKeyCol = slOrderArray(lnglN - 1) lnglThisKeyCol = slOrderArray(lnglN) slTopKeyVal = sparray(0, lnglPrevKeyCol) lnglLbound = 0 lnglUBound = UBound(sparray, 1) ' All the same. If sparray(lnglUBound, 0) = slTopKeyVal Then Exit For End If lnglArrayIndex = 0 lnglEndArray = UBound(sparray) Do lnglLbound = lnglArrayIndex slTopKeyVal = sparray(lnglArrayIndex, lnglPrevKeyCol) Do If lnglArrayIndex > lnglEndArray Then Exit Do End If slKeyVal = sparray(lnglArrayIndex, lnglPrevKeyCol) If slKeyVal <> slTopKeyVal Then lnglUBound = lnglArrayIndex - 1 Exit Do End If lnglArrayIndex = lnglArrayIndex + 1 Loop ' No need to sort if there's only ONE row. lngSubArrayRows = lnglUBound - lnglLbound If lngSubArrayRows > 1 Then ' Get those rows. ReDim slSubArray(lnglUBound - lnglLbound, lnglElements) lnglP = 0 For lnglM = lnglLbound To lnglUBound For lnglO = 0 To lnglElements slSubArray(lnglP, lnglO) = sparray(lnglM, lnglO) Next lnglO lnglP = lnglP + 1 Next lnglM ' Sort 'em. subArrayMergeSort slSubArray, lnglThisKeyCol ' Put 'em back. lnglP = 0 For lnglM = lnglLbound To lnglUBound For lnglO = 0 To lnglElements sparray(lnglM, lnglO) = slSubArray(lnglP, lnglO) Next lnglO lnglP = lnglP + 1 Next lnglM End If If lnglArrayIndex > lnglEndArray Then Exit Do End If Loop Next lnglN End If ' *********************************************************************** End Sub

Simple Array Bubble Sort Example working similar to VBA Range.Sort with one Key1:=

A further modification is done to the previous routines so that values that can be seen as numbers are compared as numbers in sorting. This is done so that, for example, a number like 46 would be seen as greater than 7. In previous routines, these would be compared as text values of "46" and "7". In a text comparison, the sort is done initially on the first character so that "4" would be seen as less that "7". ( The second character, "6", in this exampple is not used. A second character would only be used to sort if we had two values such as "46" and "49". In such an example VBA would place "49" above "46" for a text comparison

We find that the VBA Range.Sort Method sees text as text and numbers typically as numbers , and the final purpose of the routines we are developing in the associated main forum Thread is to do somethhing similar to the VBA Range.Sort Method

Code:

' ' Simplist Sort3 Sub TestieSimpleArraySort3() Call SimpleArraySort3(0) End Sub ' Sub SimpleArraySort3(Optional ByVal GlLl As Long) Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As range: Set RngToSort = WsS.range("A2:B9") ' alternative: ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types Dim arrOut() As Variant: Let arrOut() = arrTS() ' could simply use the original array and sort that ' column to be used for determining order of rows sorted array: the values in this column will be looked at Dim Clm As Long: Let Clm = 1 Rem 1 Simple Bubble Sort Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop===================================== For rOuter = 1 To UBound(arrTS(), 1) - 1 ' For row 1 to the (last row -1) last row, given by the first dimension upper limit of the array Dim rInner As Long ' -------Inner Loop-------------"Right Hand"-------------------------- For rInner = rOuter + 1 To UBound(arrOut(), 1) 'If arrOut(rOuter, Clm) > arrOut(rInner, Clm) Then ' This means that I am bigger than the next. So I will swap . I keep doing this which will have the effect of putting the smallest in the current rOuter. By the this and all next rOuter, I miss out the last, and any previous, which means I effectively do the same which puts the next smallest in this next rOuter. If GlLl = 0 Then ' We want Ascending list If IsNumeric(arrOut(rOuter, Clm)) And IsNumeric(arrOut(rInner, Clm)) Then ' Numeric case 'If UCase(CStr(arrOut(rOuter, Clm))) > UCase(CStr(arrOut(rInner, Clm))) Then 'If arrOut(rOuter, Clm) > arrOut(rInner, Clm) Then' If both values are seen to be numeric then this line would probably work, but as "belt and braces" we do the next If CDbl(arrOut(rOuter, Clm)) > CDbl(arrOut(rInner, Clm)) Then Dim temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' Non numeric case 'If UCase(CStr(arrOut(rOuter, Clm))) > UCase(CStr(arrOut(rInner, Clm))) Then If UCase(CStr(arrOut(rOuter, Clm))) > UCase(CStr(arrOut(rInner, Clm))) Then 'Dim temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value 'Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison Else ' GlLl is not 0 , so presumably we want Descending list If IsNumeric(arrOut(rOuter, Clm)) And IsNumeric(arrOut(rInner, Clm)) Then If CDbl(arrOut(rOuter, Clm)) < CDbl(arrOut(rInner, Clm)) Then 'Dim temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value 'Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' non numeric case If UCase(CStr(arrOut(rOuter, Clm))) < UCase(CStr(arrOut(rInner, Clm))) Then 'Dim temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value 'Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison End If ' End of Ascending or Descending example Next rInner ' --------------------------------------------------------------------- Next rOuter ' =========================================================================================== Rem 2 Output for easy of demo RngToSort.Offset(0, RngToSort.Columns.Count).Clear ' WsS.Columns("C:D").Clear ' CHANGE TO SUIT Let RngToSort.Offset(0, RngToSort.Columns.Count).Value = arrOut() Let RngToSort.Offset(0, RngToSort.Columns.Count).Interior.Color = vbYellow End Sub

Final comparison results are shown in the next post

The sorted array is displayed in the spreadsheet along side the original range used as test data for the inputted array. ( The yellow highlighted range is that produced by the array sort routine, Sub SimpleArraySort3() , and the green highlighted range is that produced by the VBA Range.Sort method routine, Sub Range_Sort()

Ascending Order

Code:

Sub TestieSimpleArraySort3() Call SimpleArraySort3(0) End Sub '

Code:

Sub Range_Sort() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As range: Set RngToSort = WsS.range("A2:B9") ' alternative: ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Rem 1 For demo purposes we will sort a copy of the range RngToSort.Offset(0, RngToSort.Columns.Count * 2).Clear ' WsS.Columns("E:F").Clear ' CHANGE TO SUIT RngToSort.Copy Destination:=RngToSort.Offset(0, RngToSort.Columns.Count * 2) Dim RngCopy As range: Set RngCopy = RngToSort.Offset(0, RngToSort.Columns.Count * 2) RngCopy.Sort Key1:=RngCopy.Columns("A:A"), Order1:=xlAscending, MatchCase:=False 'RngCopy.Sort Key1:=RngCopy.Columns("A:A"), Order1:=xlDescending, MatchCase:=False Let RngCopy.Interior.Color = vbGreen End Sub

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

E

F

G

1

2
c WasB2
6
WasB7
6
WasB7

3
AB WasB3
32
WasB8
32
WasB8

4
Aa WasB4 A WasB5 A WasB5

5
A WasB5 Aa WasB4 Aa WasB4

6
C WasB6 AB WasB3 AB WasB3

7

6
WasB7 bcde WasB9 bcde WasB9

8

32
WasB8 C WasB6 c WasB2

9
bcde WasB9 c WasB2 C WasB6

10

Worksheet: Sorting

Descending Order

Code:

Sub TestieSimpleArraySort3() Call SimpleArraySort3(2246) End Sub '

Code:

Sub Range_Sort() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As range: Set RngToSort = WsS.range("A2:B9") ' alternative: ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Rem 1 For demo purposes we will sort a copy of the range RngToSort.Offset(0, RngToSort.Columns.Count * 2).Clear ' WsS.Columns("E:F").Clear ' CHANGE TO SUIT RngToSort.Copy Destination:=RngToSort.Offset(0, RngToSort.Columns.Count * 2) Dim RngCopy As range: Set RngCopy = RngToSort.Offset(0, RngToSort.Columns.Count * 2) 'RngCopy.Sort Key1:=RngCopy.Columns("A:A"), Order1:=xlAscending, MatchCase:=False RngCopy.Sort Key1:=RngCopy.Columns("A:A"), Order1:=xlDescending, MatchCase:=False Let RngCopy.Interior.Color = vbGreen End Sub

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

E

F

G

1

2
c WasB2 c WasB2 c WasB2

3
AB WasB3 C WasB6 C WasB6

4
Aa WasB4 bcde WasB9 bcde WasB9

5
A WasB5 AB WasB3 AB WasB3

6
C WasB6 Aa WasB4 Aa WasB4

7

6
WasB7 A WasB5 A WasB5

8

32
WasB8
32
WasB8
32
WasB8

9
bcde WasB9
6
WasB7
6
WasB7

10

Worksheet: Sorting

_Row\^Col	A	B	C	D	E	F
1
2	c	WasB2	6	WasB7	6	WasB7
3	AB	WasB3	32	WasB8	32	WasB8
4	Aa	WasB4	A	WasB5	A	WasB5
5	A	WasB5	Aa	WasB4	Aa	WasB4
6	C	WasB6	AB	WasB3	AB	WasB3
7	6	WasB7	bcde	WasB9	bcde	WasB9
8	32	WasB8	C	WasB6	c	WasB2
9	bcde	WasB9	c	WasB2	C	WasB6
10

_Row\^Col	A	B	C	D	E	F
1
2	c	WasB2	c	WasB2	c	WasB2
3	AB	WasB3	C	WasB6	C	WasB6
4	Aa	WasB4	bcde	WasB9	bcde	WasB9
5	A	WasB5	AB	WasB3	AB	WasB3
6	C	WasB6	Aa	WasB4	Aa	WasB4
7	6	WasB7	A	WasB5	A	WasB5
8	32	WasB8	32	WasB8	32	WasB8
9	bcde	WasB9	6	WasB7	6	WasB7
10

First step in turning Bubble Sort routine into function. Routine takes in an Array (ByRef) to sort

Code:

' Sub TestieSimpleArraySort4() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("A2:B9") Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types Call SimpleArraySort4(arrTS(), 0) End Sub Sub SimpleArraySort4(ByRef arrTS() As Variant, Optional ByVal GlLl As Long) Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("A2:B9") ' alternative: ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 ' Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types Dim arrOut() As Variant: Let arrOut() = arrTS() ' could simply use the original array and sort that ' column to be used for determining order of rows sorted array: the values in this column will be looked at Dim Clm As Long: Let Clm = 1 Rem 1 Simple Bubble Sort Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop===================================== For rOuter = 1 To UBound(arrTS(), 1) - 1 ' For row 1 to the (last row -1) last row, given by the first dimension upper limit of the array Dim rInner As Long ' -------Inner Loop-------------"Right Hand"-------------------------- For rInner = rOuter + 1 To UBound(arrOut(), 1) If GlLl = 0 Then ' We want Ascending list If IsNumeric(arrOut(rOuter, Clm)) And IsNumeric(arrOut(rInner, Clm)) Then ' Numeric case If CDbl(arrOut(rOuter, Clm)) > CDbl(arrOut(rInner, Clm)) Then Dim temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' Non numeric case If UCase(CStr(arrOut(rOuter, Clm))) > UCase(CStr(arrOut(rInner, Clm))) Then For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison Else ' GlLl is not 0 , so presumably we want Descending list If IsNumeric(arrOut(rOuter, Clm)) And IsNumeric(arrOut(rInner, Clm)) Then If CDbl(arrOut(rOuter, Clm)) < CDbl(arrOut(rInner, Clm)) Then For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' non numeric case If UCase(CStr(arrOut(rOuter, Clm))) < UCase(CStr(arrOut(rInner, Clm))) Then For Clms = 1 To UBound(arrOut(), 2) Let temp = arrOut(rOuter, Clms): Let arrOut(rOuter, Clms) = arrOut(rInner, Clms): Let arrOut(rInner, Clms) = temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison End If ' End of Ascending or Descending example Next rInner ' --------------------------------------------------------------------- Next rOuter ' =========================================================================================== Rem 2 Output for easy of demo RngToSort.Offset(0, RngToSort.Columns.Count).Clear Let RngToSort.Offset(0, RngToSort.Columns.Count).Value = arrOut() Let RngToSort.Offset(0, RngToSort.Columns.Count).Interior.Color = vbYellow End Sub

Because we are using ByRef , the previous testieing Calling routine can also use the original supplied array, arrTS() , after the main procedure Call , provided that the array taken in at the signature line is that sorted, as that will in effect be the same array and it will reflect the changes done to it.

Pseudo code ByRef ‘ ( Usually default option )
varMyArray = x
_ Call ReferToIt(varMyArray)
Sub ReferToIt(ByRef arr)
_ arr=y ‘ This is similar to saying varMyArray = y
End
varMyArray is now = y ‘ because effectively varMyArray was in arr

Code:

' Sub TestieSimpleArraySort4b() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("A2:B9") ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types Call SimpleArraySort4b(arrTS(), 0) Rem 2 Output for easy of demo RngToSort.Offset(0, RngToSort.Columns.Count).Clear Let RngToSort.Offset(0, RngToSort.Columns.Count).Value = arrTS() Let RngToSort.Offset(0, RngToSort.Columns.Count).Interior.Color = vbYellow End Sub Sub SimpleArraySort4b(ByRef arsRef() As Variant, Optional ByVal GlLl As Long) ' column to be used for determining order of rows sorted array: the values in this column will be looked at Dim Clm As Long: Let Clm = 1 Rem 1 Simple Bubble Sort Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop===================================== For rOuter = 1 To UBound(arsRef(), 1) - 1 ' For row 1 to the (last row -1) last row, given by the first dimension upper limit of the array Dim rInner As Long ' -------Inner Loop-------------"Right Hand"-------------------------- For rInner = rOuter + 1 To UBound(arsRef(), 1) If GlLl = 0 Then ' We want Ascending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then ' Numeric case If CDbl(arsRef(rOuter, Clm)) > CDbl(arsRef(rInner, Clm)) Then Dim Temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' Non numeric case If UCase(CStr(arsRef(rOuter, Clm))) > UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison Else ' GlLl is not 0 , so presumably we want Descending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then If CDbl(arsRef(rOuter, Clm)) < CDbl(arsRef(rInner, Clm)) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' non numeric case If UCase(CStr(arsRef(rOuter, Clm))) < UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison End If ' End of Ascending or Descending example Next rInner ' --------------------------------------------------------------------- Next rOuter ' =========================================================================================== End Sub

Initial Function for Simple Bubble Sort

In the routines
Sub TestieSimpleArraySort5() and Function SimpleArraySort5(______) As Variant
below , the main difference over the previous routines is the extra As Variant at the signature line, and finally a code line just before End Function of SimpleArraySort5 = arsRef()

In the testieing routine, we use codes line of this form in the conventional way in which a function is typically used.
_ arrTS() = SimpleArraySort5(arrTS(), _ 0 _ )
But we note that by virtue of using ByRef a simple call would surfice
_Call SimpleArraySort5(arrTS(), _ 0 _ )

Note: we have added an extra testing code section '2b)
In this extra section we fill a new array, arrDesc() , with the sorted array in Descending order. We use for demo purposes a typical function using code line
_ arrDesc() = SimpleArraySort5(arrTS(), 2136)
Correspondingly we have a demo output giving code line
_ RngToSort.Offset(0, RngToSort.Columns.Count * 3).Value = arrDesc()

We note further, that this is somewhat redundant. This is because the code part SimpleArraySort5(arrTS(), 2136) has the effect of re filling arrTS() with the newly sorted array by virtue of the use of ByRef in the signature line of the Function
We could therefore simply use a code line like _..
_Call SimpleArraySort5(arrTS(), 357)
_.. followed by an demo output giving line of
_ RngToSort.Offset(0, RngToSort.Columns.Count * 3).Value = arrTS()

Code:

Sub TestieSimpleArraySort5() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("A2:B9") ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types Call SimpleArraySort5(arrTS(), 0) Let arrTS() = SimpleArraySort5(arrTS(), 0) Rem 2 Output for easy of demo ' 2a) Ascending RngToSort.Offset(0, RngToSort.Columns.Count).Clear Let RngToSort.Offset(0, RngToSort.Columns.Count).Value = arrTS() Let RngToSort.Offset(0, RngToSort.Columns.Count).Interior.Color = vbYellow ' 2b) Descending ( using diiffernet variable ) Dim arrDesc() As Variant Let arrDesc() = SimpleArraySort5(arrTS(), 2136) RngToSort.Offset(0, RngToSort.Columns.Count * 3).Clear Let RngToSort.Offset(0, RngToSort.Columns.Count * 3).Value = arrDesc() Let RngToSort.Offset(0, RngToSort.Columns.Count * 3).Value = arrTS() ' Because we use ByRef this would work after any normal Call of SimpleArraySort5(arrTS(), ) The actual call we use puts the sorted array in arrTS() The important bit is SimpleArraySort5(arrTS(), ) After this arrTS() with the newly sorted array by virtue of the use of ByRe in the signature line of this Function has the effect of refilling arrTS() with the newly sorted in descending order values Let RngToSort.Offset(0, RngToSort.Columns.Count * 3).Interior.Color = vbYellow End Sub Function SimpleArraySort5(ByRef arsRef() As Variant, Optional ByVal GlLl As Long) As Variant ' column to be used for determining order of rows sorted array: the values in this column will be looked at Dim Clm As Long: Let Clm = 1 Rem 1 Simple Bubble Sort Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop===================================== For rOuter = 1 To UBound(arsRef(), 1) - 1 ' For row 1 to the (last row -1) last row, given by the first dimension upper limit of the array Dim rInner As Long ' -------Inner Loop-------------"Right Hand"-------------------------- For rInner = rOuter + 1 To UBound(arsRef(), 1) If GlLl = 0 Then ' We want Ascending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then ' Numeric case If CDbl(arsRef(rOuter, Clm)) > CDbl(arsRef(rInner, Clm)) Then Dim Temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' Non numeric case If UCase(CStr(arsRef(rOuter, Clm))) > UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison Else ' GlLl is not 0 , so presumably we want Descending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then If CDbl(arsRef(rOuter, Clm)) < CDbl(arsRef(rInner, Clm)) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' non numeric case If UCase(CStr(arsRef(rOuter, Clm))) < UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison End If ' End of Ascending or Descending example Next rInner ' --------------------------------------------------------------------- Next rOuter ' =========================================================================================== Let SimpleArraySort5 = arsRef() End Function

In the next post are some typical test results for the above coding

Some typical resullts using the coding from the last post

Consider this test input range

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

1

2
c WasB2

3
AB WasB3

4
Aa WasB4

5
A WasB5

6
C WasB6

7

6
WasB7

8

32
WasB8

9
bcde WasB9

10

Worksheet: Sorting

After running Sub TestieSimpleArraySort5() , you should see this:

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

E

F

G

H

I

1

2
c WasB2
6
WasB7 C WasB6

3
AB WasB3
32
WasB8 c WasB2

4
Aa WasB4 A WasB5 bcde WasB9

5
A WasB5 Aa WasB4 AB WasB3

6
C WasB6 AB WasB3 Aa WasB4

7

6
WasB7 bcde WasB9 A WasB5

8

32
WasB8 C WasB6
32
WasB8

9
bcde WasB9 c WasB2
6
WasB7

10

Worksheet: Sorting

_Row\^Col	A	B
1
2	c	WasB2
3	AB	WasB3
4	Aa	WasB4
5	A	WasB5
6	C	WasB6
7	6	WasB7
8	32	WasB8
9	bcde	WasB9
10

_Row\^Col	A	B	C	D	G	H
1
2	c	WasB2	6	WasB7	C	WasB6
3	AB	WasB3	32	WasB8	c	WasB2
4	Aa	WasB4	A	WasB5	bcde	WasB9
5	A	WasB5	Aa	WasB4	AB	WasB3
6	C	WasB6	AB	WasB3	Aa	WasB4
7	6	WasB7	bcde	WasB9	A	WasB5
8	32	WasB8	C	WasB6	32	WasB8
9	bcde	WasB9	c	WasB2	6	WasB7
10

Final Demo of recursion array sort on multi coliumns

Take an example,
A list of Foods, their name in first column and a few other things like calories(Kcal) and Salt content in other columns

First I want to sort to group similar products (based on alphabetical order, but ascending or descending is not important) - This will be sorting on column 1 values

Within similar food types, I want to list them in an order of how healthy they might be, ( or at least in the order of least unhealthy ) .
Most important would be order starting with lowest Kcal.
After that for similar products with similar Kcal , we would consider the minimum salt content as likely to be the less unhealthy.

This might be our list
_____ ( Using Excel 2007 32 bit )

_Row\^Col
R

S

T

U

V

W

22
Food Product Was S22 Kcal Was U22 Salt Was W22

23
Crisps Was S23
500
Was U23
0.7
Was W23

24
Beer Was S24
200
Was U24
0.1
Was W24

25
Wine Was S25
150
Was U25
0.15
Was W25

26
Beer Was S26
200
Was U26
0.07
Was W26

27
beer Was S27
220
Was U27
0.2
Was W27

28
Beer Was S28
210
Was U28
0.06
Was W28

29
Wine Was S29
160
Was U29
0.04
Was W29

30
wiNe Was S30
150
Was U30
0.03
Was W30

31
Crisps Was S31
502
Was U31
2
Was W31

32
Onion Ringes Was S32
480
Was U32
1
Was W32

33
Onion Ringes Was S33
490
Was U33
1.5
Was W33

34
Crisps Was S34
502
Was U34
1.5
Was W34

35
CRISPS Was S35
500
Was U35
1.1
Was W35

36
Wine Was S36
170
Was U36
0.1
Was W36

37
Crisps Was S37
500
Was U37
3
Was W37

Worksheet: Sorting

Here is a demo Calling test routine

Code:

Sub TestieSimpleArraySort6() Rem 0 test data, worksheets info Dim WsS As Worksheet: Set WsS = ThisWorkbook.Worksheets("Sorting") Dim RngToSort As Range: Set RngToSort = WsS.Range("R23:W37") ' Set RngToSort = Selection ' ' Selection.JPG : https://imgur.com/HnCdBt8 Dim arrTS() As Variant: Let arrTS() = RngToSort.Value ' We would have to use .Value for a range capture of this sort because .Value returns a field of Variant types. But also at this stage we want to preserve string and number types ' Call SimpleArraySort6(1, arrTS(), " 1 2 3 4 5 ", " 1 Asc 2 Asc 3 Asc") Dim cnt As Long, strIndcs As String: Let strIndcs = " " For cnt = 1 To RngToSort.Rows.Count Let strIndcs = strIndcs & cnt & " " Next cnt Debug.Print strIndcs ' For 5 rows , for example we will have " 1 2 3 4 5 " , for 15 rows " 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 " Call SimpleArraySort6(1, arrTS(), strIndcs, " 1 Desc 3 Asc 5 Asc") Rem 2 Output for easy of demo ' 2a RngToSort.Offset(0, RngToSort.Columns.Count).Clear Let RngToSort.Offset(0, RngToSort.Columns.Count).Value = arrTS() Let RngToSort.Offset(0, RngToSort.Columns.Count).Interior.Color = vbYellow ' 2b VBA Range.Sort Method equivalent Dim TestRngSrt As Range: Set TestRngSrt = RngToSort.Offset(0, RngToSort.Columns.Count * 2) TestRngSrt.Clear Let TestRngSrt.Value = RngToSort.Value TestRngSrt.Sort Key1:=TestRngSrt.Columns("A:A"), order1:=xlDescending, Key2:=TestRngSrt.Columns("C:C"), order2:=xlAscending, Key3:=TestRngSrt.Columns("E:E"), order3:=xlAscending TestRngSrt.Interior.Color = vbGreen End Sub '

That above routine uses the test range R23:W37 above and feeds that to the main recursion routine below in the next post. The demo routine also does the VBA Range.Sort equivalent code line

_Row\^Col	R	S	T	U	V	W
22	Food Product	Was S22	Kcal	Was U22	Salt	Was W22
23	Crisps	Was S23	500	Was U23	0.7	Was W23
24	Beer	Was S24	200	Was U24	0.1	Was W24
25	Wine	Was S25	150	Was U25	0.15	Was W25
26	Beer	Was S26	200	Was U26	0.07	Was W26
27	beer	Was S27	220	Was U27	0.2	Was W27
28	Beer	Was S28	210	Was U28	0.06	Was W28
29	Wine	Was S29	160	Was U29	0.04	Was W29
30	wiNe	Was S30	150	Was U30	0.03	Was W30
31	Crisps	Was S31	502	Was U31	2	Was W31
32	Onion Ringes	Was S32	480	Was U32	1	Was W32
33	Onion Ringes	Was S33	490	Was U33	1.5	Was W33
34	Crisps	Was S34	502	Was U34	1.5	Was W34
35	CRISPS	Was S35	500	Was U35	1.1	Was W35
36	Wine	Was S36	170	Was U36	0.1	Was W36
37	Crisps	Was S37	500	Was U37	3	Was W37

Final Main recursion Array sort using multi columns routine below

Code:

' ' Main recursion routine below : Bubble Sorting in Arrays using multi columns values for sort criteria Sub SimpleArraySort6(ByVal CpyNo As Long, ByRef arsRef() As Variant, ByVal strRws As String, ByVal strKeys As String) Dim CopyNo As Long: Let CopyNo = CpyNo ' On every recurssion run this will be increased by the Rec Call. This will be a local variable indicating the level down in recursion - I increase it by 1 at every Rec Call, that is to say each Rec Call gets given CopyNo+1 - during a long tunnel down, the number at this pint will keep increasing to reflect how far down we are If CopyNo = 1 Then Debug.Print "First procedure Call" Rem -1 from the supplied arguments, get all data needed in current bubble sort ' Column for this level sort , and Ascending or Descending - both determined from the supplied forth arguments and the column/ copy number Dim Keys() As String: Let Keys() = Split(Replace(Trim(strKeys), " ", " ", 1, -1, vbBinaryCompare), " ", -1, vbBinaryCompare) '' The extra replace allows for me seperating with one or two spaces - the following would do if I only used one space always Split(Trim(strKeys), " ", -1, vbBinaryCompare) ' this will be an array twice as big as the number of keys that we have If (2 * CopyNo) > UBound(Keys()) + 1 Then MsgBox Prompt:="You need more than " & (UBound(Keys()) + 1) / 2 & " keys to complete sort": Exit Sub ' case we have less keys then we need to sort, are array has twice as many elements as we have supplied keys since we have a key and whether it needs to get bigger or smaller , and array is from 0 so must add 1 to ubound then half it get the key number we gave. We come here if the last column we gave as a Key had duplicates in it Dim GlLl As Long: If Keys((CopyNo * 2) - 1) = "Desc" Then Let GlLl = 1 ' (CopyNo * 2) - 1) gives as we go down levels 1 3 5 7 etc We're seeing if we had Desc for this column Dim Clm As Long: Let Clm = CLng(Keys((CopyNo * 2) - 2)) ' ' (CopyNo * 2) - 2) gives as we go down levels 0 2 4 6 etc We are picking out the supplied column to sort by for each level ' making an array from the " 3 4 5 6 " string is just for convenience later of getting the upper and lower row numbers Dim Rws() As String: Let Rws() = Split(Trim(strRws), " ", -1, vbBinaryCompare) ' We take the supplied sequential string 2 3 4 5 6 and make a 1 D array {1, 2, 3....} as it is a bit more conveniant to work with. Actually we only need the start and top numbers so we could do it with stinr manipulation instead Rem 1 Simple Bubble Sort Dim rOuter As Long ' ========"Left Hand"=====================Outer Loop===================================== For rOuter = Rws(LBound(Rws())) To Rws(UBound(Rws()) - 1) ' For first row indicie to last but one row indicie Dim rInner As Long ' -------Inner Loop-------------"Right Hand"-------------------------- For rInner = rOuter + 1 To Rws(UBound(Rws())) ' from just above left hand through all the rest If GlLl = 0 Then ' We want Ascending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then ' Numeric case If CDbl(arsRef(rOuter, Clm)) > CDbl(arsRef(rInner, Clm)) Then Dim Temp As Variant ' I want to Swap those 2 above - I cant easilly in any coding change two values simulataneosly. So one of them Element values will put in this temporary place. This Element Values will then be given the other. Finally the other Element will be given this temporary value Dim Clms As Long '-------| with the condition met a loop is done for all columns in the array in which those two values used in the comparison are replaced at each column For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' Non numeric case If UCase(CStr(arsRef(rOuter, Clm))) > UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison Else ' GlLl is not 0 , so presumably we want Descending list If IsNumeric(arsRef(rOuter, Clm)) And IsNumeric(arsRef(rInner, Clm)) Then If CDbl(arsRef(rOuter, Clm)) < CDbl(arsRef(rInner, Clm)) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If Else ' non numeric case If UCase(CStr(arsRef(rOuter, Clm))) < UCase(CStr(arsRef(rInner, Clm))) Then For Clms = 1 To UBound(arsRef(), 2) Let Temp = arsRef(rOuter, Clms): Let arsRef(rOuter, Clms) = arsRef(rInner, Clms): Let arsRef(rInner, Clms) = Temp Next Clms '----------| for each column in the array at the two rows rOuter and rInner Else End If End If ' End of numeric or text comparison End If ' End of Ascending or Descending example Next rInner ' --------------------------------------------------------------------- Next rOuter ' =========================================================================================== ' Captains Blog, just fo info Debug.Print " Running Copy " & CopyNo & " of routine." & vbCr & vbLf & " Sorted rows " & strRws & " based on values in column " & Clm & vbCr & vbLf & " Checking now for Dups in that last sorted list" & vbCr & vbLf ' Rem 3 Determine any duplicates in sort column values , and re run the routine to sort them by another column Let rOuter = Rws(LBound(Rws())) - 1 ' we look for duplicates in the current list, in the loop below we add 1 each time so _ it is necersarry to start 1 before, so that +1 the first time is the start row Let strRws = "" ' ready for use in duplicate search Do ' Loop down the last set of sorted rows ****************************************************| Let rOuter = rOuter + 1 ' next row number _ it was necersarry to start 1 before, so that +1 the first time is the start row If strRws = "" Or Trim(strRws) = rOuter - 1 Then Let strRws = " " & rOuter & " " ' case starting again to get duplicates If Trim(UCase(CStr(arsRef(rOuter, Clm)))) = Trim(UCase(CStr(arsRef(rOuter + 1, Clm)))) Then ' case in duplicate rows Let strRws = strRws & rOuter + 1 & " " ' we building a list like " 4 5 6 " based on if the next is a duplicate value, which is determined by the last line Else ' when we did not have a next duplicate, we may have a few already grouped If Not InStr(1, Trim(strRws), " ", vbBinaryCompare) = 0 Then ' case we have at least 2 duplicates but have hit end of that list Debug.Print "Found dups in last list column " & Clm & ", " & strRws & " , so now Rec Call 1" ' This is done for every duplicated value section, except if we have duplicates at the last lines Call SimpleArraySort6(CopyNo + 1, arsRef(), strRws, strKeys) ' Rec Call 1 I need to sort the last duplicates Let strRws = "" ' ready to try for another set of duplicates Else End If End If ' this is the end of the stuff in most situations... ' ...below section catches rows at the end that might need to be sorted. ......| If rOuter = UBound(arsRef(), 1) - 1 And Not InStr(1, Trim(strRws), " ", vbBinaryCompare) = 0 Then ' case of duplicates in last row Debug.Print "Found dups in last list, so now Rec Call 2 (Dups at list end case)" ' Rec Call 2 - only done for duplicates at end of list Call SimpleArraySort6(CopyNo + 1, arsRef(), strRws, strKeys) Else End If '... ................................................................| Loop While rOuter <> Rws(UBound(Rws()) - 1) ' keep looking for Duplicates in next row**********| End Sub

Typical results in the next post:

2	10	8	2	16	8	1	10	15	2
8	1	10	15	2	19	6	3	14	13
15	15	10	6	13	13	7	6	15	16
2	17	2	8	3	5	9	11	12	8
15	12	15	4	5	2	10	8	2	16
13	13	6	4	11	15	12	15	4	5
19	6	3	14	13	13	13	6	4	11
5	9	11	12	8	15	15	10	6	13
14	18	18	16	20	2	17	2	8	3
13	7	6	15	16	14	18	18	16	20

14	2	2.9986	17	1	1.9983
15	6	6.9985	19	1	1.9981
16	3	3.9984	20	1	1.998
17	1	1.9983	14	2	2.9986
18	2	2.9982	18	2	2.9982
19	1	1.9981	16	3	3.9984
20	1	1.998	15	6	6.9985

Sub	sub	d	Sub	func	h
Sub	func	h	Pub	pub	a
sub	pub	x	func	pub	m
func	pub	m	Pub	pub	p
func	pub	r	func	pub	r
Pub	pub	a	sub	pub	x
Pub	pub	p	Sub	sub	d

2	10	8	2	16	8	1	10	15	2
8	1	10	15	2	19	6	3	14	13
15	15	10	6	13	13	7	6	15	16
2	17	2	8	3	5	9	11	12	8
15	12	15	4	5	2	10	8	2	16
13	13	6	4	11	15	12	15	4	5
19	6	3	14	13	13	13	6	4	11
5	9	11	12	8	15	15	10	6	13
14	18	18	16	20	2	17	2	8	3
13	7	6	15	16	14	18	18	16	20

2	10	8	2	16	8	1	10	15	2
8	1	10	15	2	19	6	3	14	13
15	15	10	6	13	13	7	6	15	16
2	17	2	8	3	5	9	11	12	8
15	12	15	4	5	2	10	8	2	16
13	13	6	4	11	15	12	15	4	5
19	6	3	14	13	13	13	6	4	11
5	9	11	12	8	15	15	10	6	13
14	18	18	16	20	2	17	2	8	3
13	7	6	15	16	14	18	18	16	20