VPN Forum access and IP addresse Tests

Simple Array Bubble Sort Example with Range.Sort Equivalent

You've entered a domain name. We've found an IP address from the domain name you've entered. Your translated IP address is 192.185.44.245

Geolocation data from IP2Location (Product: DB6, 2024-5-1)

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Massachusetts

CITY:
Burlington

ISP:
WebsiteWelcome.com

ORGANIZATION:
Not available

LATITUDE:
42.5085

LONGITUDE:
-71.2011
Geolocation data from ipinfo.io (Product: API, real-time)

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Georgia

CITY:
Atlanta

ISP:
Not available

ORGANIZATION:
AS19871 Network Solutions, LLC

LATITUDE:
33.7490

LONGITUDE:
-84.3880
Geolocation data from DB-IP (Product: API, real-time )

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Massachusetts

CITY:
Burlington

ISP:
Network Solutions, LLC

ORGANIZATION:
Websitewelcome.com

LATITUDE:
42.4958

LONGITUDE:
-71.1934
Geolocation data from IPregistry.co (Product: API, real-time)

IP ADDRESS:
192.185.44.245

COUNTRY:
United States

REGION:
Massachusetts

CITY:
Burlington

ISP:
Network Solutions, LLC

ORGANIZATION:
WEBSITEWELCOME.COM (websitewelcome.com)

LATITUDE:
42.50852

LONGITUDE:
-71.20105
Geolocation data from IPGeolocation.io (Product: API, real-time)

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Georgia

CITY:
Atlanta

ISP:
WEBSITEWELCOME.COM

ORGANIZATION:
WEBSITEWELCOME.COM

LATITUDE:
33.74831

LONGITUDE:
-84.39111
Geolocation data from IPapi.co (Product: API, real-time)

IP ADDRESS:
192.185.44.245

COUNTRY:
United States

REGION:
Massachusetts

CITY:
Burlington

ISP:
NETWORK-SOLUTIONS-HOSTING

ORGANIZATION:
NETWORK-SOLUTIONS-HOSTING

LATITUDE:
42.509

LONGITUDE:
-71.1984
Geolocation data from ipbase.com (Product: API, real-time)

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Massachusetts

CITY:
Burlington

ISP:
WEBSITEWELCOME.COM

ORGANIZATION:
WEBSITEWELCOME.COM

LATITUDE:
42.5085

LONGITUDE:
-71.2011
Geolocation data from criminalip.io (Product: API, real-time)

DOMAIN NAME:
www.excelfox.com

COUNTRY:
United States

REGION:
Not available

CITY:
Not available

ISP:
Not available

ORGANIZATION:
Network Solutions Hosting

LATITUDE:
37.7510

LONGITUDE:
-97.8220

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

G

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

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
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

_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

_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

Simpla Array Bubble Sort Program allowing for Ascending or Descending order

The last routine, Sub TestieSimpleArraySort(), has a section dupilcated to allow for selection of a final list sorted in Ascending or descending order.
If supplied 0, or , no GlLl argument is given, then the final list should be sorted in Ascending order

Code:

' Simplist Sort2 Sub TestieSimpleArraySort2() Call SimpleArraySort2(0) End Sub ' Sub SimpleArraySort2(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 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 Else ' GlLl is not 0 , so presumably we want Descending list 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 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

Results for this callind procedure

Code:

Sub TestieSimpleArraySort2() Call SimpleArraySort2(0) Call SimpleArraySort End Sub '

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

2
c WasB2
32
WasB8

3
AB WasB3
6
WasB7

4
Aa WasB4 A WasB5

5
A WasB5 Aa WasB4

6
C WasB6 AB WasB3

7

6
WasB7 bcde WasB9

8

32
WasB8 C WasB6

9
bcde WasB9 c WasB2

Worksheet: Sorting

Results for this calling procedure

Code:

Sub TestieSimpleArraySort2() Call SimpleArraySort2(732847) End Sub '

_____ ( Using Excel 2007 32 bit )

_Row\^Col
A

B

C

D

2
c WasB2 c WasB2

3
AB WasB3 C WasB6

4
Aa WasB4 bcde WasB9

5
A WasB5 AB WasB3

6
C WasB6 Aa WasB4

7

6
WasB7 A WasB5

8

32
WasB8
6
WasB7

9
bcde WasB9
32
WasB8

Worksheet: Sorting

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

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

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