Option Explicit
Option Base 1
Dim GroupsArray()
Public xlApplication As New clsAppEvents
Sub TrapApplicationEvents()
Set xlApplication.xlApp = Application
End Sub
Sub ShowFindDups()
fmFindDups.Show
End Sub
Sub ShowFindLike()
fmFindLike.Show
End Sub
Sub ShowFindLikeList()
fmFindLikeList.Show
End Sub
Sub ShowFindGaps()
fmFindGaps.Show
End Sub
Sub ShowFindVal()
fmFindVal.Show
End Sub
Function BEGINT(AlphNumStr As String) As Long
Dim l As Long, i As Long
Dim NumStr As String
On Error GoTo ErrorHandler
l = Len(AlphNumStr)
For i = 1 To l
If IsNumeric(Mid(AlphNumStr, i, 1)) = True Then
NumStr = NumStr & Mid(AlphNumStr, i, 1)
Else
Exit For
End If
Next
BEGINT = CLng(NumStr)
Exit Function
ErrorHandler:
BEGINT = 0
End Function
Function ENDINT(AlphNumStr As String) As Long
Dim l As Long, i As Long
Dim NumStr As String
On Error GoTo ErrorHandler
l = Len(AlphNumStr)
For i = l To 1 Step -1
If IsNumeric(Mid(AlphNumStr, i, 1)) = True Then
NumStr = Mid(AlphNumStr, i, 1) & NumStr
Else
Exit For
End If
Next
ENDINT = CLng(NumStr)
Exit Function
ErrorHandler:
ENDINT = 0
End Function
Function BEGNUM(AlphNumStr As String) As Double
Dim l As Integer, i As Integer, it As Long
Dim NumStr As String
On Error GoTo ErrorHandler
l = Len(AlphNumStr)
For i = 1 To l
If IsNumeric(Mid(AlphNumStr, 1, 1 + it)) = True Then
it = it + 1
NumStr = NumStr & Mid(AlphNumStr, i, 1)
Else
Exit For
End If
Next
BEGNUM = CDbl(NumStr)
Exit Function
ErrorHandler:
BEGNUM = 0
End Function
Function ENDNUM(AlphNumStr As String) As Single
Dim l As Integer, i As Long, it As Long
Dim NumStr As String
On Error GoTo ErrorHandler
l = Len(AlphNumStr)
For i = l To 1 Step -1
If IsNumeric(Mid(AlphNumStr, i, 1 + it)) = True Then
it = it + 1
NumStr = Mid(AlphNumStr, i, 1) & NumStr
Else
Exit For
End If
Next
ENDNUM = CSng(NumStr)
Exit Function
ErrorHandler:
ENDNUM = 0
End Function
Function ApproxEqFix(Comp1Fig As Double, Comp2Fig As Double, PermVar As Double) As Integer
Dim Diff As Double
On Error GoTo ErrorHandler
If PermVar < 0 Then GoTo ErrorHandler
Diff = Comp1Fig - Comp2Fig
If Diff < 0 Then
Diff = Diff * -1
End If
If Diff <= PermVar Then
ApproxEqFix = 1
Else
ApproxEqFix = 0
End If
Exit Function
ErrorHandler:
ApproxEqFix = 0
End Function
Function ApproxEqPerc(Comp1Fig As Double, Comp2Fig As Double, PerCent As Double) As Integer
Dim Diff As Double
Dim PermDiff As Double
On Error GoTo ErrorHandler
If PerCent < 0 Then GoTo ErrorHandler
PermDiff = Comp1Fig * PerCent / 100
Diff = Comp1Fig - Comp2Fig
If Diff < 0 Then
Diff = Diff * -1
End If
If Diff <= PermDiff Then
ApproxEqPerc = 1
Else
ApproxEqPerc = 0
End If
Exit Function
ErrorHandler:
ApproxEqPerc = 0
End Function
Sub ShowFindSigNum()
fmFindSigNum.Show
End Sub
Sub showFindLists()
fmFindLists.Show
End Sub
Sub ShowCompList()
fmCompList.Show
End Sub
Sub ShowCompListVal()
fmCompListVal.Show
End Sub
Sub ShowCreateKey()
fmCreateKey.Show
End Sub
Sub ShowMatchingRecords()
fmMatchingRec.Show
End Sub
Sub ShowMarkCurrOrd()
fmMarkCurrOrd.Show
End Sub
Function NthINT(MyStr As String, Nth As Long) As Variant
Dim StrLen As Long
Dim r As Integer, s As Integer, t As Integer
Dim TestStr As String
Dim ReturnVal As Variant
If Nth < 1 Then GoTo ErrorHandler
StrLen = Len(MyStr)
If StrLen < Nth Then GoTo ErrorHandler
For r = 1 To StrLen
TestStr = Mid(MyStr, r, 1)
If Not TestStr = " " And IsNumeric(TestStr) Then
s = s + 1
If s = Nth Then
t = CInt(TestStr)
Exit For
End If
End If
Next
If s < Nth Then GoTo ErrorHandler
NthINT = t
Exit Function
ErrorHandler:
ReturnVal = "#Error"
NthINT = ReturnVal
End Function
Function SUMDIGITS(MyString As String) As Long
Dim MyLen As Long
Dim MyAnswer As Long
Dim i As Integer, r As Integer, s As Integer, t As Integer
MyAnswer = 0
MyLen = Len(MyString)
For i = 1 To MyLen
If IsNumeric(Mid(MyString, i, 1)) Then
MyAnswer = MyAnswer + CInt(Mid(MyString, i, 1))
End If
Next
SUMDIGITS = MyAnswer
End Function
Function COMPanyDIGIT(Str1 As String, Str2 As String) As Integer
Dim Str1Len As Integer
Dim Str2Len As Integer
Dim TestDig As String
Dim Str1DigArray()
Dim Str2DigArray()
Dim NoStr1 As String
Dim NoStr2 As String
Dim r As Integer, s As Integer, t As Integer
Str1Len = Len(Str1)
For r = 1 To Str1Len
TestDig = Mid(Str1, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
s = s + 1
ReDim Preserve Str1DigArray(2, s)
Str1DigArray(1, s) = TestDig
Str1DigArray(2, s) = "n"
End If
Next
For r = 0 To 9
For t = 1 To s
If Str1DigArray(1, t) = r And Str1DigArray(2, t) = "n" Then
NoStr1 = NoStr1 & CStr(Str1DigArray(1, t))
Str1DigArray(2, t) = "y"
End If
Next t
Next r
s = 0
Str2Len = Len(Str2)
For r = 1 To Str2Len
TestDig = Mid(Str2, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
s = s + 1
ReDim Preserve Str2DigArray(2, s)
Str2DigArray(1, s) = TestDig
Str2DigArray(2, s) = "n"
End If
Next
For r = 0 To 9
For t = 1 To s
If Str2DigArray(1, t) = r And Str2DigArray(2, t) = "n" Then
NoStr2 = NoStr2 & CStr(Str2DigArray(1, t))
Str2DigArray(2, t) = "y"
End If
Next t
Next r
If NoStr1 = NoStr2 Then
COMPanyDIGIT = 1
Else
COMPanyDIGIT = 0
End If
End Function
Function COMPordDIGIT(Str1 As String, Str2 As String) As Integer
Dim Str1Len As Integer
Dim Str2Len As Integer
Dim TestDig As String
Dim NoStr1 As String
Dim NoStr2 As String
Dim r As Integer, s As Integer, t As Integer
Str1Len = Len(Str1)
For r = 1 To Str1Len
TestDig = Mid(Str1, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
NoStr1 = NoStr1 & TestDig
End If
Next
Str2Len = Len(Str2)
For r = 1 To Str2Len
TestDig = Mid(Str2, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
NoStr2 = NoStr2 & TestDig
End If
Next
If NoStr1 = NoStr2 Then
COMPordDIGIT = 1
Else
COMPordDIGIT = 0
End If
End Function
Function INTfrmPOS(MyStr As String, Optional Pos As Long) As Variant
Dim StrLen As Integer
Dim CharLen As Integer
Dim StartVal As Long
Dim TestStr As String
Dim StartFlag As String
Dim r As Integer, s As Integer, t As Integer
Dim IntStr As String
Dim ReturnVal As Variant
StrLen = Len(MyStr)
If Pos > 0 Then
StartVal = Pos
Else
StartVal = 1
End If
StartFlag = "n"
StrLen = Len(MyStr)
If StartVal > StrLen Then GoTo ErrorHandler
For r = StartVal To StrLen
TestStr = Mid(MyStr, r, 1)
If Not TestStr = " " And IsNumeric(TestStr) Then
s = s + 1
IntStr = IntStr & TestStr
StartFlag = "y"
Else
If StartFlag = "y" Then
Exit For
End If
End If
Next
If s = 0 Then GoTo ErrorHandler
INTfrmPOS = CLng(IntStr)
Exit Function
ErrorHandler:
ReturnVal = "#Error"
INTfrmPOS = ReturnVal
End Function
Function INTfrmCHAR(MyStr As String, Char As String, Optional Pos As Long) As Variant
Dim StrLen As Long
Dim CharLen As Integer
Dim StartVal As Long
Dim TestStr As String
Dim StartFlag As String
Dim r As Integer, s As Integer, t As Integer
Dim IntStr As String
Dim ReturnVal As Variant
If Pos > 0 Then
StartVal = Pos
Else
StartVal = 1
End If
StartVal = InStr(StartVal, MyStr, Char)
If StartVal < 1 Then GoTo ErrorHandler
CharLen = Len(Char)
StrLen = Len(MyStr)
StartVal = StartVal + CharLen
StartFlag = "n"
StrLen = Len(MyStr)
For r = StartVal To StrLen
TestStr = Mid(MyStr, r, 1)
If Not TestStr = " " And IsNumeric(TestStr) Then
s = s + 1
IntStr = IntStr & TestStr
StartFlag = "y"
Else
If StartFlag = "y" Then
Exit For
End If
End If
Next
If s = 0 Then GoTo ErrorHandler
INTfrmCHAR = CLng(IntStr)
Exit Function
ErrorHandler:
ReturnVal = "#Error"
INTfrmCHAR = ReturnVal
End Function
Function COMPanyDIGITBool(Str1 As String, Str2 As String) As Boolean
Dim Str1Len As Integer
Dim Str2Len As Integer
Dim TestDig As String
Dim Str1DigArray()
Dim Str2DigArray()
Dim NoStr1 As String
Dim NoStr2 As String
Dim r As Integer, s As Integer, t As Integer
Str1Len = Len(Str1)
For r = 1 To Str1Len
TestDig = Mid(Str1, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
s = s + 1
ReDim Preserve Str1DigArray(2, s)
Str1DigArray(1, s) = TestDig
Str1DigArray(2, s) = "n"
End If
Next
For r = 0 To 9
For t = 1 To s
If Str1DigArray(1, t) = r And Str1DigArray(2, t) = "n" Then
NoStr1 = NoStr1 & CStr(Str1DigArray(1, t))
Str1DigArray(2, t) = "y"
End If
Next t
Next r
s = 0
Str2Len = Len(Str2)
For r = 1 To Str2Len
TestDig = Mid(Str2, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
s = s + 1
ReDim Preserve Str2DigArray(2, s)
Str2DigArray(1, s) = TestDig
Str2DigArray(2, s) = "n"
End If
Next
For r = 0 To 9
For t = 1 To s
If Str2DigArray(1, t) = r And Str2DigArray(2, t) = "n" Then
NoStr2 = NoStr2 & CStr(Str2DigArray(1, t))
Str2DigArray(2, t) = "y"
End If
Next t
Next r
If NoStr1 = NoStr2 Then
COMPanyDIGITBool = True
Else
COMPanyDIGITBool = False
End If
End Function
Function COMPordDIGITBool(Str1 As String, Str2 As String) As Boolean
Dim Str1Len As Integer
Dim Str2Len As Integer
Dim TestDig As String
Dim NoStr1 As String
Dim NoStr2 As String
Dim r As Integer, s As Integer, t As Integer
Str1Len = Len(Str1)
For r = 1 To Str1Len
TestDig = Mid(Str1, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
NoStr1 = NoStr1 & TestDig
End If
Next
Str2Len = Len(Str2)
For r = 1 To Str2Len
TestDig = Mid(Str2, r, 1)
If Not TestDig = " " And IsNumeric(TestDig) Then
NoStr2 = NoStr2 & TestDig
End If
Next
If NoStr1 = NoStr2 Then
COMPordDIGITBool = True
Else
COMPordDIGITBool = False
End If
End Function
Function NUMDIGITS(MyString As String) As Integer
Dim MyLen As Integer
Dim MyAnswer As Long
Dim i As Integer, r As Integer, s As Integer, t As Integer
MyLen = Len(MyString)
For i = 1 To MyLen
If IsNumeric(Mid(MyString, i, 1)) And Not Mid(MyString, i, 1) = " " Then
s = s + 1
End If
Next
NUMDIGITS = s
End Function
Sub ShowfmBegEndNumInt()
fmBegEndNumInt.Show
End Sub
Sub ShowfmINTfrmCHAR()
fmINTfrmCHAR.Show
End Sub
Sub ShowfmINTfrmPOS()
fmINTfrmPOS.Show
End Sub
Sub ShowfmNthINT()
fmNthINT.Show
End Sub
Sub ShowfmNumDigits()
fmNumDigits.Show
End Sub
Sub ShowfmSUMDigits()
fmSumDigits.Show
End Sub
Function VAL_POS_NUMARRAY(Pos As Integer, MyString As String) As Double
Dim ReturnVal As Variant
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
If Pos > 0 And Pos <= UBound(GroupsArray, 2) Then
ReturnVal = GroupsArray(3, Pos)
Else
GoTo ErrorHandle
End If
If GroupsArray(1, 1) > 0 Then
VAL_POS_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
VAL_POS_NUMARRAY = -1
End Function
Function NUM_NUMARRAY(MyString As String) As Long
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
If GroupsArray(1, 1) > 0 Then
NUM_NUMARRAY = UBound(GroupsArray, 2)
Else
NUM_NUMARRAY = 0
End If
Exit Function
ErrorHandle:
NUM_NUMARRAY = -1
End Function
Function STA_POS_NUMARRAY(Pos As Long, MyString As String) As Long
Dim ReturnVal As Variant
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
If Pos > 0 And Pos <= UBound(GroupsArray, 2) Then
ReturnVal = GroupsArray(1, Pos)
Else
GoTo ErrorHandle
End If
If GroupsArray(1, 1) > 0 Then
STA_POS_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
STA_POS_NUMARRAY = -1
End Function
Function LEN_POS_NUMARRAY(Pos As Long, MyString As String) As Long
Dim ReturnVal As Variant
On Error GoTo ErrorHandle
FillGroupsArray (MyString)
If Pos > 0 And Pos <= UBound(GroupsArray, 2) Then
ReturnVal = GroupsArray(2, Pos)
Else
GoTo ErrorHandle
End If
If GroupsArray(1, 1) > 0 Then
LEN_POS_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
LEN_POS_NUMARRAY = -1
End Function
Function PRECHAR_POS_NUMARRAY(Pos As Long, MyString As String) As Variant
Dim ReturnVal As Variant
On Error GoTo ErrorHandle
FillGroupsArray (MyString)
If Pos > 0 And Pos <= UBound(GroupsArray, 2) Then
If GroupsArray(1, Pos) = 1 Then
GoTo ErrorHandle
Else
ReturnVal = GroupsArray(4, Pos)
If ReturnVal > 31 Then
ReturnVal = "''" & Chr(ReturnVal) & "'"
End If
End If
Else
GoTo ErrorHandle
End If
If GroupsArray(1, 1) > 0 Then
PRECHAR_POS_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
PRECHAR_POS_NUMARRAY = -1
End Function
Function POSTCHAR_POS_NUMARRAY(Pos As Long, MyString As String) As Variant
Dim ReturnVal As Variant
Dim MyLen As Long
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
MyLen = Len(MyString)
If Pos > 0 And Pos <= UBound(GroupsArray, 2) Then
If GroupsArray(1, Pos) + GroupsArray(2, Pos) > MyLen Then
GoTo ErrorHandle
Else
ReturnVal = GroupsArray(5, Pos)
If ReturnVal > 31 Then
ReturnVal = "''" & Chr(ReturnVal) & "'"
End If
End If
Else
GoTo ErrorHandle
End If
If GroupsArray(1, 1) > 0 Then
POSTCHAR_POS_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
POSTCHAR_POS_NUMARRAY = -1
End Function
Function NUM_LENMATCH_NUMARRAY(MyString As String, Operator As String, StringLen As Long) As Long
Dim ReturnVal As Variant
Dim i As Long, r As Long, s As Long, t As Long
Dim MatchNo As Long
Dim MyMatch As Boolean
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(2, i) > StringLen)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(2, i) >= StringLen)
Case "=", "equals"
MyMatch = (GroupsArray(2, i) = StringLen)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(2, i) <= StringLen)
Case "<", "less than"
MyMatch = (GroupsArray(2, i) < StringLen)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(2, i) > StringLen)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
End If
Next
If GroupsArray(1, 1) > 0 Then
NUM_LENMATCH_NUMARRAY = MatchNo
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
NUM_LENMATCH_NUMARRAY = -1
End Function
Function POS_Nth_LENMATCH_NUMARRAY(MyString As String, Operator As String, StringLen As Long, Nth As Long) As Long
Dim ReturnVal As Variant
Dim i As Long, r As Long, s As Long, t As Long
Dim MyMatch As Boolean
Dim MatchNo As Integer
Dim MatchFlag As String
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(2, i) > StringLen)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(2, i) >= StringLen)
Case "=", "equals"
MyMatch = (GroupsArray(2, i) = StringLen)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(2, i) <= StringLen)
Case "<", "less than"
MyMatch = (GroupsArray(2, i) < StringLen)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(2, i) > StringLen)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
If MatchNo = Nth Then
MatchFlag = "y"
ReturnVal = i
Exit For
End If
End If
Next
If MatchFlag = "y" Then
POS_Nth_LENMATCH_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
POS_Nth_LENMATCH_NUMARRAY = -1
End Function
Function NUM_VALMATCH_NUMARRAY(MyString As String, Operator As String, CompVal As Double) As Long
Dim ReturnVal As Variant
Dim i As Long, r As Long, s As Long, t As Long
Dim MyMatch As Boolean
Dim MatchNo As Integer
Dim MatchFlag As String
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(3, i) > CompVal)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(3, i) >= CompVal)
Case "=", "equals"
MyMatch = (GroupsArray(3, i) = CompVal)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(3, i) <= CompVal)
Case "<", "less than"
MyMatch = (GroupsArray(3, i) < CompVal)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(3, i) > CompVal)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
End If
Next
If GroupsArray(1, 1) > 0 Then
NUM_VALMATCH_NUMARRAY = MatchNo
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
NUM_VALMATCH_NUMARRAY = -1
End Function
Function POS_Nth_VALMATCH_NUMARRAY(MyString As String, Operator As String, CompVal As Double, Nth As Long) As Long
Dim ReturnVal As Variant
Dim i As Long, r As Long, s As Long, t As Long
Dim MyMatch As Boolean
Dim MatchNo As Integer
Dim MatchFlag As String
On Error GoTo ErrorHandle
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(3, i) > CompVal)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(3, i) >= CompVal)
Case "=", "equals"
MyMatch = (GroupsArray(3, i) = CompVal)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(3, i) <= CompVal)
Case "<", "less than"
MyMatch = (GroupsArray(3, i) < CompVal)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(3, i) > CompVal)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
If MatchNo = Nth Then
MatchFlag = "y"
ReturnVal = i
Exit For
End If
End If
Next
If MatchFlag = "y" Then
POS_Nth_VALMATCH_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
POS_Nth_VALMATCH_NUMARRAY = -1
End Function
Function NUM_STAMATCH_NUMARRAY(MyString As String, Operator As String, CompStartPos As Long) As Long
Dim ReturnVal As Variant
Dim i As Long
Dim MyMatch As Boolean
Dim MatchNo As Integer
Dim MatchFlag As String
Dim MyLen As Long
On Error GoTo ErrorHandle
MyLen = Len(MyString)
If CompStartPos < 1 Or CompStartPos > MyLen Then
GoTo ErrorHandle
End If
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(1, i) > CompStartPos)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(1, i) >= CompStartPos)
Case "=", "equals"
MyMatch = (GroupsArray(1, i) = CompStartPos)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(1, i) <= CompStartPos)
Case "<", "less than"
MyMatch = (GroupsArray(1, i) < CompStartPos)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(1, i) > CompStartPos)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
End If
Next
If GroupsArray(1, 1) > 0 Then
NUM_STAMATCH_NUMARRAY = MatchNo
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
NUM_STAMATCH_NUMARRAY = -1
End Function
Function POS_Nth_STAMATCH_NUMARRAY(MyString As String, Operator As String, CompStartPos As Long, Nth As Long) As Long
Dim ReturnVal As Variant
Dim i As Long, r As Long, s As Long, t As Long
Dim MyLen As Long
Dim MyMatch As Boolean
Dim MyNum As Double
Dim MatchNo As Integer
Dim MatchFlag As String
On Error GoTo ErrorHandle
MyLen = Len(MyString)
If CompStartPos < 1 Or CompStartPos > MyLen Or Nth < 1 Then
GoTo ErrorHandle
End If
Call FillGroupsArray(MyString)
For i = 1 To UBound(GroupsArray, 2)
Select Case Operator
Case ">", "greater than"
MyMatch = (GroupsArray(1, i) > CompStartPos)
Case "=>", "equals or greater than", ">=", "greater than or equals"
MyMatch = (GroupsArray(1, i) >= CompStartPos)
Case "=", "equals"
MyMatch = (GroupsArray(1, i) = CompStartPos)
Case "=<", "equals or less than", "<=", "less than or equals"
MyMatch = (GroupsArray(1, i) <= CompStartPos)
Case "<", "less than"
MyMatch = (GroupsArray(1, i) < CompStartPos)
Case ">", "not equal to", "does not equal"
MyMatch = (GroupsArray(1, i) > CompStartPos)
Case Else
GoTo ErrorHandle
End Select
If MyMatch Then
MatchNo = MatchNo + 1
If MatchNo = Nth Then
MatchFlag = "y"
ReturnVal = i
Exit For
End If
End If
Next
If MatchFlag = "y" Then
POS_Nth_STAMATCH_NUMARRAY = ReturnVal
Else
GoTo ErrorHandle
End If
Exit Function
ErrorHandle:
POS_Nth_STAMATCH_NUMARRAY = -1
End Function
Sub FillGroupsArray(MyString As String)
Dim StartGrp As String
Dim MyLen As Long
Dim CheckChar As String
Dim StartPos As Long
Dim CommaCount As Integer
Dim GroupsNo As Long
Dim GrpLen As Long
Dim r As Long, s As Long, t As Long
Dim StopCheck As String
Dim CommaCheck As String
Dim CommaGroupCheck As String
Dim CommaPos As Long
ReDim GroupsArray(5, 1)
StartGrp = "n"
MyLen = Len(MyString)
For r = 1 To MyLen
CheckChar = Mid(MyString, r, 1)
If IsNumeric(CheckChar) Then
If StartGrp = "n" Then
StartGrp = "y"
StartPos = r
CommaCount = 0
GroupsNo = GroupsNo + 1
If GroupsNo = 1 Then
ReDim GroupsArray(5, GroupsNo)
Else
ReDim Preserve GroupsArray(5, GroupsNo)
End If
GrpLen = 1
End If
CommaCount = CommaCount + 1
GrpLen = r - StartPos + 1
If StartGrp = "y" And r = MyLen Then
GroupsArray(1, GroupsNo) = StartPos
GroupsArray(2, GroupsNo) = GrpLen
GroupsArray(3, GroupsNo) = CDbl(Mid(MyString, StartPos, GrpLen))
GroupsArray(4, GroupsNo) = Asc(Mid(MyString, StartPos - 1, 1))
'GroupsArray(5, GroupsNo) = Asc(Mid(MyString, StartPos + GrpLen, 1))
End If
Else
If Asc(CheckChar) = 44 Or Asc(CheckChar) = 46 Then
If Asc(CheckChar) = 46 Then
If StartGrp = "y" Then
If StopCheck = "y" Then
GroupsArray(1, GroupsNo) = StartPos
GroupsArray(2, GroupsNo) = GrpLen
GroupsArray(3, GroupsNo) = CDbl(Mid(MyString, StartPos, GrpLen))
If StartPos > 1 Then
GroupsArray(4, GroupsNo) = Asc(Mid(MyString, StartPos - 1, 1))
End If
GroupsArray(5, GroupsNo) = Asc(Mid(MyString, StartPos + GrpLen, 1))
StartGrp = "n"
StartPos = 0
StopCheck = "n"
GrpLen = 0
CommaCheck = "n"
CommaGroupCheck = "n"
CommaCount = 0
Else
StopCheck = "y"
End If
Else
End If
End If
If Asc(CheckChar) = 44 Then
If StartGrp = "y" Then
If CommaCount > 3 Then
GroupsArray(1, GroupsNo) = StartPos
GroupsArray(2, GroupsNo) = GrpLen
GroupsArray(3, GroupsNo) = CDbl(Mid(MyString, StartPos, GrpLen))
If StartPos > 1 Then
GroupsArray(4, GroupsNo) = Asc(Mid(MyString, StartPos - 1, 1))
End If
GroupsArray(5, GroupsNo) = Asc(Mid(MyString, StartPos + GrpLen, 1))
StartGrp = "n"
StartPos = 0
StopCheck = "n"
GrpLen = 0
CommaCount = 0
CommaCheck = "n"
CommaGroupCheck = "n"
End If
If CommaCheck = "y" Then
If CommaCount > 3 Then
GrpLen = CommaPos - StartPos
GroupsArray(1, GroupsNo) = StartPos
GroupsArray(2, GroupsNo) = GrpLen
GroupsArray(3, GroupsNo) = CDbl(Mid(MyString, StartPos, GrpLen))
If StartPos > 1 Then
GroupsArray(4, GroupsNo) = Asc(Mid(MyString, StartPos - 1, 1))
End If
GroupsArray(5, GroupsNo) = Asc(Mid(MyString, StartPos + GrpLen, 1))