Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

**DocAElstein** · 02-18-2019, 02:51 PM

Coding in support of this excelfox Thread:
llkslksjjsjfaslkjflkajflkjflfjj later sajfsladj

Code:

Option Explicit


'
' Range.Sort Example
Sub RangeSortExample()
 range("G13:K19").Sort Key1:=range("G13:K19").Columns("B:B"), Order1:=xlAscending, Key2:=range("G13:K19").Columns("D:D"), order2:=xlAscending, MatchCase:=False, Key3:=range("G13:K19").Columns("E:E"), order3:=xlDescending, MatchCase:=False
End Sub ' Matchcase:=False '




' Simplist Sort
Sub SimpleArraySort()
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 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
        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
' Approximate equivalent to the above routune, using VBA Range.Sort Method '  https://docs.microsoft.com/de-de/office/vba/api/excel.range.sort
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
'
 Let RngCopy.Interior.Color = vbGreen
End Sub

Typical results:
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 SimpleArraySort() , and the green highlighted range is that produced by the VBA Range.Sort method routine, Sub Range_Sort()
More examples in next post.

_____ ( Using Excel 2007 32 bit )

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

Worksheet: Sorting

**DocAElstein** · 02-18-2019, 02:58 PM

Further Examples using the routines from the previous 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 SimpleArraySort() , and the green highlighted range is that produced by the VBA Range.Sort method routine, Sub Range_Sort()

_____ ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F
1
2	c	WasB2	32	WasB8	6	WasB7
3	AB	WasB3	6	WasB7	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

To reverse this to descending so that things “get smaller as you go down the rows”, you simply need to change
the > to a < in the array routine
and
the Order1:=xlAscending to Order1:=xlDescending in the VBA Range.Sort routine
_____ ( Using Excel 2007 32 bit )

_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	6	WasB7	32	WasB8
9	bcde	WasB9	32	WasB8	6	WasB7
10

Worksheet: Sorting

I intended developing the solution into a function, so as a start to this, the routine will be modified to take an Optional argument of 0 or 1 , with the default of 0 being the case for an Ascending list. I am not being particularly efficient with the coding, and will duplicate sections.

A full routine is posted in the next post