Hello RinconPaul,
The attached workbook has a button on "Sheet1" to call the macros and display the race selection numbers in ascending order in a message box. Try this out and let me know how it works for you.
Module1 Macro
Sub GetSlections()
Dim Cell As Range
Dim Data As Variant
Dim Format As Long
Dim Group1 As Variant
Dim Group2 As Variant
Dim Group3 As Variant
Dim Header As Variant
Dim n As Long
Dim Numbers As Object
Dim RegExp As Object
Dim Text As String
Dim vArray As Variant
Dim Wks As Worksheet
Dim x As Long
Set Wks = ActiveSheet
Group1 = Array(Array("Selections"), Array(1))
Group2 = Array(Array("Sky Predictor", "Early Speed"), Array(2))
Group3 = Array(Array("SkyForm Rating", "Best Form (12mths)", "Recent Form", "Distance", _
"Class", "Time Rating", "Start Type", "Best Overall"), Array(3))
Set Numbers = CreateObject("Scripting.Dictionary")
Set RegExp = CreateObject("VBScript.RegExp")
For Each Header In Array(Group1, Group2, Group3)
Format = Header(1)(0)
For x = 0 To UBound(Header(0))
Set Cell = Wks.Cells.Find(Header(0)(x), , xlValues, xlWhole, xlByRows, xlNext, False, False, False)
If Not Cell Is Nothing Then
Do
n = n + 1
Text = Cell.Offset(n, 0).Value
Select Case Format
Case 1
RegExp.Global = True
RegExp.Pattern = "\D(\d+)\s\-.*"
Do
If Text = "" Then GoTo NextHeader
Set Matches = RegExp.Execute(Text & "-")
If Matches.Count = 0 Then Exit Do
Data = Val(Matches(0).SubMatches(0))
Text = Right(Text, Len(Text) - (Matches(0).FirstIndex + Len(Data) + 1))
If Not Numbers.Exists(Data) Then Numbers.Add Data, ""
Loop
Case 2
RegExp.Global = False
RegExp.Pattern = "\d+"
If RegExp.Test(Text) = False Then GoTo NextHeader
Data = Val(Text)
If Not Numbers.Exists(Data) Then Numbers.Add Data, ""
Case 3
RegExp.Global = False
RegExp.Pattern = "(\d+)\s.*"
Set Matches = RegExp.Execute(Text)
If Matches.Count = 0 Then GoTo NextHeader
Text = Matches(0).SubMatches(0)
Data = Val(Text)
If Not Numbers.Exists(Data) Then Numbers.Add Data, ""
End Select
Loop
NextHeader:
n = 0
End If
Next x
Next Header
vArray = SortList(Numbers.Keys)
MsgBox Join(vArray, ", ")
End Sub
Module - Sort_Modified
Function SortList(ByRef vList As Variant, Optional Descending As Boolean) As Variant
' Written: November 27, 2013
' Author: Leith Ross
Dim arr As Variant
Dim col As Variant
Dim LB As Long
Dim J As Long
Dim Sorted As Boolean
Dim UB As Long
Dim Temp As Variant
arr = vList
UB = UBound(arr)
Do
Sorted = True
For J = LBound(arr) To UB - 1
If Descending Xor arr(J) > arr(J + 1) Then
Temp = arr(J + 1)
arr(J + 1) = arr(J)
arr(J) = Temp
Sorted = False
End If
Next J
UB = UB - 1
Loop Until Sorted Or UB < 1
SortList = arr
End Function
Reply With Quote
