Question

I’m using GSKinner’s Reg Exr tool to help come up with a pattern that can locate authorization numbers in a field that contains a whole lot of other garbage. The authorization number is a string that contains letters (sometimes), numbers (always), and hyphens (sometimes) (i.e. the authorization always contains a number somewhere, but doesn’t always contains hyphens and letters). Additionally, the authorization number can be located anywhere in the field I am searching.

Examples of proper authorization numbers include:

 5555834384734  ' All digits
 12110-AANM     ' Alpha plus digits, plus hyphens
 R-455545-AB-9  ' Alpha plus digits, plus multiple hyphens
 R-45-54A-AB-9  ' Alpha plus digits, plus multiple hyphens
 W892160        ' Alpha plus digits without hypens

Here’s some sample data with the additional garbage, which is sometimes appended to the real authorization number with a hyphen or no space, making it look like part of the number. The garbage comes though in predictable forms/words: REF, CHEST, IP, AMB, OBV, and HOLD that are not part of the authorization number.

 5557653700 IP
 R025257413-001
 REF 120407175
 SNK601M71016
 U0504124 AMB
 W892160
 019870270000000
 00Q926K2
 A025229563
 01615217 AMB
 12042-0148
 SNK601M71016
 12096NHP174
 12100-ACDE
 12110-AANM
 12114AD5QIP
 REF-34555
 3681869/OBV ONL

Here’s the pattern I’m using:

 "\b[a-zA-Z]*[\d]+[-]*[\d]*[A-Za-z0-9]*[\b]*"

I’m learning RegExp so it no doubt can be improved, but it works for the above, just not for the below situations:

 REFA5-208-4990IP  'Extract the string 'A5-208-4990'without REF or IP
 OBV1213110379     'Extract the string '1213110379' without the OBV
 5520849900AMB     'Extract the string '5520849900' without AMB
 5520849900CHEST   'Extract the string '5520849900' without CHEST
 5520849900-IP     'Extract the string '5520849900' without -IP
 1205310691-OBV    'Extract the string without the -OBV
 R-025257413-001   'Numbers of this form should also be allowed.
 NO PCT 93660      'If string contains the word NO anywhere, it is not a match
 HOLDA5-208-4990   'If string contains the word HOLD anywhere, it is not a match

Can someone help?

For testing purposes, here’s Sub that creates a table with sample input data:

 Sub CreateTestAuth()

 Dim dbs As Database
 Set dbs = CurrentDb

 With dbs
     .Execute "CREATE TABLE tbl_test_auth " _
         & "(AUTHSTR CHAR);"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('5557653700 IP');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "(' R025257413-001');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('REF 120407175');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('SNK601M71016');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('U0504124 AMB');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('3681869/OBV ONL');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('REFA5-208-4990IP');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('5520849900AMB');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('5520849900CHEST');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('5520849900-IP');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('1205310691-OBV');"
     .Execute " INSERT INTO tbl_test_auth " _
         & "(AUTHSTR) VALUES " _
         & "('HOLDA5-208-4990');"
     .Close
 End With
 End Sub

Answer 1

Your sample inputfile (path to this file s/b given to function<GetMatches> as inputFilePath):

5557653700 IP
R025257413-001
REF 120407175
SNK601M71016
U0504124 AMB
W892160
019870270000000
00Q926K2
A025229563
01615217 AMB
12042-0148
SNK601M71016
12096NHP174
12100-ACDE
12110-AANM
12114AD5QIP
REF-34555
3681869/OBV ONL

here’s the junks saved in file(path to this file s/b given to function<GetMatches> as replaceDBPath):

^REF
IP$
^OBV
AMB$
CHEST$
-OBV$
^.*(NO|HOLD).*$

And here goes the bas:

Option Explicit
'This example uses the following references:
'Microsoft VBScript Regular Expressions 5.5 and Microsoft Scripting Runtime

Private fso As New Scripting.FileSystemObject
Private re As New VBScript_RegExp_55.RegExp

Private Function GetJunkList(fpath$) As String()
0     On Error GoTo errHandler
1     If fso.FileExists(fpath) Then
2         Dim junkList() As String, mts As MatchCollection, mt As Match, pos&, tmp$
3         tmp = fso.OpenTextFile(fpath).ReadAll()
4         With re
5             .Global = True
6             .MultiLine = True
7             .Pattern = "[^\r\n]+"
8             Set mts = .Execute(tmp)
9             ReDim junkList(mts.Count - 1)
10            For Each mt In mts
11                junkList(pos) = mt.Value
12                pos = pos + 1
13            Next mt
14        End With
15        GetJunkList = junkList
16    Else
17        MsgBox "File not found at:" & vbCr & fpath
18    End If
19    Exit Function
errHandler:
     Dim Msg$
     With Err
         Msg = "Error '" & .Number & " " & _
        .Description & "' occurred in " & _
        "Function<GetJunkList> at line # " & IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
     End With
     MsgBox Msg, vbCritical
End Function

Public Function GetMatches(replaceDBPath$, inputFilePath$) As String()
0     On Error GoTo errHandler
1     Dim junks() As String, junkPat$, tmp$, results() As String, pos&, mts As MatchCollection, mt As Match
2     junks = GetJunkList(replaceDBPath)
3     tmp = fso.OpenTextFile(inputFilePath).ReadAll
4
5     With re
6        .Global = True
7        .MultiLine = True
8        .IgnoreCase = True
9        For pos = LBound(junks) To UBound(junks)
10           .Pattern = junkPat
11           junkPat = junks(pos)
12           'replace junk with []
13           tmp = .Replace(tmp, "")
14       Next pos
15
16       'trim lines [if all input data in one line]
17       .Pattern = "^[ \t]*|[ \t]*$"
18       tmp = .Replace(tmp, "")
19
20       'create array using provided pattern
21       pos = 0
22       .Pattern = "\b[a-z]*[\d]+\-*\d*[a-z0-9]*\b"
23       Set mts = .Execute(tmp)
24       ReDim results(mts.Count - 1)
25       For Each mt In mts
26           results(pos) = mt.Value
27           pos = pos + 1
28       Next mt
29    End With
30
31    GetMatches = results
32    Exit Function
errHandler:
     Dim Msg$
     With Err
         Msg = "Error '" & .Number & " " & _
        .Description & "' occurred in " & _
        "Function<GetMatches> at line # " & IIf(Erl <> 0, " at line " & CStr(Erl) & ".", ".")
     End With
     MsgBox Msg, vbCritical
End Function

And a sample tester

Public Sub tester()
    Dim samples() As String, s
    samples = GetMatches("C:\Documents and Settings\Cylian\Desktop\junks.lst", "C:\Documents and Settings\Cylian\Desktop\sample.txt")
    For Each s In samples
        MsgBox s
    Next
End Sub

may be called from immediate window:

tester

---

Hope this helps.