MS Access Find specific text format in string

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • umpscott
    New Member
    • Oct 2018
    • 2

    MS Access Find specific text format in string

    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
    Recognized Expert Top Contributor
    • Mar 2016
    • 1430

    #2
    An interesting half hour.

    Not sure what you want to do with the output, but this should work (anyway it does with your example.
    Code:
    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
    Code:
    Function ExtracNumbers(InputStr as String) As String
    and the "InputStr" should not be mentioned on lines 6,12,13 & 14.

    Phil

    Comment

    • NeoPa
      Recognized Expert Moderator MVP
      • Oct 2006
      • 32665

      #3
      Hi.

      I haven't tested this but it should do the job for you.
      Code:
      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

      Comment

      • umpscott
        New Member
        • Oct 2018
        • 2

        #4
        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)

        Comment

        • NeoPa
          Recognized Expert Moderator MVP
          • Oct 2006
          • 32665

          #5
          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 ;-)
          Code:
          '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 :
          Code:
          ?ExtractVals("-4444-333 try 1111-777789 if that's0000-8753-9999-");
          1111-7777
          0000-8753

          Comment

          Working...