MS Access Find specific text format in string

[umpscott]

Hi. Thank you in advance for helping or attempting to help.

I have an access DB with a memo field. This memo field contains lots of information, which is hand-typed and not consistent.

I need to pull from this field a string the matches the following format

####-####

(That being 4 numbers, a dash, then 4 numbers.)

I would prefer to use a built in function, but am comfortable with using VBA.

Examples:
123 text more text account 1234-5678 text more text
test more text 12321324234 acct: 2345-6789 text more text
test-moretext 1234 5678 Account Number 3456-7890 text more

Results would return:
1234-5678
2345-6789
3456-7890

[PhilOfWalton]

An interesting half hour.

Not sure what you want to do with the output, but this should work (anyway it does with your example.

Option Compare Database
Option Explicit
 
Function ExtractNumbers() As String
 
    Dim InputStr As String
    Dim Lngi As Long
    Dim Lngj As Long
    Dim Intk As Integer
    Dim SavedNumbers As String
 
    InputStr = "123 text more text account 1234-5678 text more text "
    InputStr = InputStr & "test more text 12321324234 acct: 2345-6789 text more text "
    InputStr = InputStr & "test-moretext 1234 5678 Account Number 3456-7890 text more"
 
    For Lngi = 1 To Len(InputStr)
        If Not IsNumeric(Mid(InputStr, Lngi, 1)) And Mid(InputStr, Lngi, 1) <> "-" Then
            Lngj = 1
            GoTo NextLngI
        End If
        'Stop
        If Lngj + 9 > Len(InputStr) Then        ' Past the end
            Exit Function
        End If
 
        For Lngj = 0 To 8
       ' Debug.Print Mid(InputStr, Lngi + Lngj, 1)
            If Lngj <= 4 Then
                If Not IsNumeric(Mid(InputStr, Lngi + Lngj, 1)) And Mid(InputStr, Lngi + Lngj, 1) <> "-" Then         ' Not a number
                    GoTo NextLngI
                End If
            End If
            If Lngj = 4 Then                            ' Look for dash
                If Mid(InputStr, Lngi + Lngj, 1) <> "-" Then         ' Not a dash
                    GoTo NextLngI
                End If
            End If
            If Lngj > 5 Then
                If Not IsNumeric(Mid(InputStr, Lngi + Lngj, 1)) And Mid(InputStr, Lngi + Lngj, 1) <> "-" Then          ' Not a number
                    GoTo NextLngI
                End If
            End If
        Next Lngj
 
        Stop
        For Intk = 0 To 8
            SavedNumbers = SavedNumbers & Mid(InputStr, Lngi + Intk, 1)
        Next Intk
 
        Debug.Print SavedNumbers
        SavedNumbers = ""
NextLngI:
    Lngi = Lngi + Lngj - 1
    Next Lngi
 
End Function

Note that the function should really start off with

Function ExtracNumbers(InputStr as String) As String

and the "InputStr" should not be mentioned on lines 6,12,13 & 14.

Phil

[NeoPa]

Hi.

I haven't tested this but it should do the job for you.

Public Function ExtractVals(ByVal strInput As String) As String
    Dim lngNext As Long
    Dim strWork As String
 
    Do While strInput Like "*####-####*"
        lngNext = InStr(lngNext + 1, strInput, "-")
        If lngNext > 4 Then
            strWork = Mid(strInput, lngNext - 4, 9)
            If strWork Like "####-####" Then
                ExtractVals = ExtractVals & VbNewLine & strWork
                lngNext = lngNext + 4
            End If
        End If
    Loop
    If ExtractVals > "" Then ExtractVals = Mid(ExtractVals, 3)
End Function

[umpscott]

I appreciate your help with this. I tried to put this into use, but it seems to hang up every time I attempt to use it. (Even on a sample record set containing only 8 records)

[NeoPa]

When I tested it, it came up with similar results :-( It was busy in an interminable loop.

Try this revised version. I've tested it this time ;-)

'ExtractVals() extracts values that match the format ####=#### from strInput.
Public Function ExtractVals(ByVal strInput As String) As String
    Dim lngNext As Long
    Dim strWork As String
 
    lngNext = 1
    Do While Mid(strInput, lngNext) Like "*####-####*"
        lngNext = InStr(lngNext, strInput, "-")
        If lngNext > 4 Then
            strWork = Mid(strInput, lngNext - 4, 9)
            If strWork Like "####-####" Then
                ExtractVals = ExtractVals & vbNewLine & strWork
                lngNext = lngNext + 4
            End If
        End If
        lngNext = lngNext + 1
    Loop
    If ExtractVals > "" Then ExtractVals = Mid(ExtractVals, 3)
End Function

I tried the following test in the Immediate Pane with the results shown :

?ExtractVals("-4444-333 try 1111-777789 if that's0000-8753-9999-");
1111-7777
0000-8753