By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,847 Members | 2,292 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,847 IT Pros & Developers. It's quick & easy.

MS Access Find specific text format in string

P: 2
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
Oct 18 '18 #1
Share this Question
Share on Google+
4 Replies


PhilOfWalton
Expert 100+
P: 1,430
An interesting half hour.

Not sure what you want to do with the output, but this should work (anyway it does with your example.
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Function ExtractNumbers() As String
  5.  
  6.     Dim InputStr As String
  7.     Dim Lngi As Long
  8.     Dim Lngj As Long
  9.     Dim Intk As Integer
  10.     Dim SavedNumbers As String
  11.  
  12.     InputStr = "123 text more text account 1234-5678 text more text "
  13.     InputStr = InputStr & "test more text 12321324234 acct: 2345-6789 text more text "
  14.     InputStr = InputStr & "test-moretext 1234 5678 Account Number 3456-7890 text more"
  15.  
  16.     For Lngi = 1 To Len(InputStr)
  17.         If Not IsNumeric(Mid(InputStr, Lngi, 1)) And Mid(InputStr, Lngi, 1) <> "-" Then
  18.             Lngj = 1
  19.             GoTo NextLngI
  20.         End If
  21.         'Stop
  22.         If Lngj + 9 > Len(InputStr) Then        ' Past the end
  23.             Exit Function
  24.         End If
  25.  
  26.         For Lngj = 0 To 8
  27.        ' Debug.Print Mid(InputStr, Lngi + Lngj, 1)
  28.             If Lngj <= 4 Then
  29.                 If Not IsNumeric(Mid(InputStr, Lngi + Lngj, 1)) And Mid(InputStr, Lngi + Lngj, 1) <> "-" Then         ' Not a number
  30.                     GoTo NextLngI
  31.                 End If
  32.             End If
  33.             If Lngj = 4 Then                            ' Look for dash
  34.                 If Mid(InputStr, Lngi + Lngj, 1) <> "-" Then         ' Not a dash
  35.                     GoTo NextLngI
  36.                 End If
  37.             End If
  38.             If Lngj > 5 Then
  39.                 If Not IsNumeric(Mid(InputStr, Lngi + Lngj, 1)) And Mid(InputStr, Lngi + Lngj, 1) <> "-" Then          ' Not a number
  40.                     GoTo NextLngI
  41.                 End If
  42.             End If
  43.         Next Lngj
  44.  
  45.         Stop
  46.         For Intk = 0 To 8
  47.             SavedNumbers = SavedNumbers & Mid(InputStr, Lngi + Intk, 1)
  48.         Next Intk
  49.  
  50.         Debug.Print SavedNumbers
  51.         SavedNumbers = ""
  52. NextLngI:
  53.     Lngi = Lngi + Lngj - 1
  54.     Next Lngi
  55.  
  56. End Function
Note that the function should really start off with
Expand|Select|Wrap|Line Numbers
  1. Function ExtracNumbers(InputStr as String) As String
and the "InputStr" should not be mentioned on lines 6,12,13 & 14.

Phil
Oct 19 '18 #2

NeoPa
Expert Mod 15k+
P: 31,307
Hi.

I haven't tested this but it should do the job for you.
Expand|Select|Wrap|Line Numbers
  1. Public Function ExtractVals(ByVal strInput As String) As String
  2.     Dim lngNext As Long
  3.     Dim strWork As String
  4.  
  5.     Do While strInput Like "*####-####*"
  6.         lngNext = InStr(lngNext + 1, strInput, "-")
  7.         If lngNext > 4 Then
  8.             strWork = Mid(strInput, lngNext - 4, 9)
  9.             If strWork Like "####-####" Then
  10.                 ExtractVals = ExtractVals & VbNewLine & strWork
  11.                 lngNext = lngNext + 4
  12.             End If
  13.         End If
  14.     Loop
  15.     If ExtractVals > "" Then ExtractVals = Mid(ExtractVals, 3)
  16. End Function
Oct 19 '18 #3

P: 2
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)
Dec 10 '18 #4

NeoPa
Expert Mod 15k+
P: 31,307
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 ;-)
Expand|Select|Wrap|Line Numbers
  1. 'ExtractVals() extracts values that match the format ####=#### from strInput.
  2. Public Function ExtractVals(ByVal strInput As String) As String
  3.     Dim lngNext As Long
  4.     Dim strWork As String
  5.  
  6.     lngNext = 1
  7.     Do While Mid(strInput, lngNext) Like "*####-####*"
  8.         lngNext = InStr(lngNext, strInput, "-")
  9.         If lngNext > 4 Then
  10.             strWork = Mid(strInput, lngNext - 4, 9)
  11.             If strWork Like "####-####" Then
  12.                 ExtractVals = ExtractVals & vbNewLine & strWork
  13.                 lngNext = lngNext + 4
  14.             End If
  15.         End If
  16.         lngNext = lngNext + 1
  17.     Loop
  18.     If ExtractVals > "" Then ExtractVals = Mid(ExtractVals, 3)
  19. End Function
I tried the following test in the Immediate Pane with the results shown :
Expand|Select|Wrap|Line Numbers
  1. ?ExtractVals("-4444-333 try 1111-777789 if that's0000-8753-9999-");
  2. 1111-7777
  3. 0000-8753
Dec 10 '18 #5

Post your reply

Sign in to post your reply or Sign up for a free account.