VBA code for extracting three specific number patterns

[enstmagoo]

Hello, I am working in excel and need VBA code to extract 3 specific number patterns. In column A I have several rows of strings which include alphabetical characters, numbers, and punctuation. I need to remove all characters except those found in a 13-digit number (containing only numbers), a ten-digit number (containing only numbers), or a 9-digit number immediately followed by an "x" character. These are isbn numbers.


The remaining characters should be separated by one, and only one, space. So, for the following string found in A1: "There are several books here, including 0192145789 and 9781245687456. Also, the book with isbn 045789541x is included. This book is one of 100000000 copies."


The output should be: 0192145789 9781245687456 045789541x


Note that the number 100000000 should not be included in the output because it does not match any of the three patterns mentioned above.


I'm not opposed to a excel formula solution as opposed to VBA, but I assumed that VBA would be cleaner. Thanks in advance.

[ashleyuk1984]

If possible can you supply us with a sample workbook with just a few lines of data (you can upload workbooks in the advanced editor screen).
This will allow up to see what sort of data that we're working with. We can also trial and error our codes / formulas, to suit your requirements. :)

[jonh]

Public Function GetISBN(txt As String) As String
For Each s In Split(FltrISBN(txt), " ")
If s <> "" Then chkISBN s, GetISBN
Next
End Function

Private Sub chkISBN(s, str As String)
If Not (Len(s) = 10 Or Len(s) = 13) Then Exit Sub
For i = 1 To Len(s)
Select Case Asc(Mid(s, i, 1))
Case 48 To 57
Case 120, 88: If Len(s) <> 10 Or i <> Len(s) Then Exit Sub
Case Else: Exit Sub
End Select
Next
If Len(str) Then str = str & " "
str = str & s
End Sub

Private Function FltrISBN(s As String) As String
For i = 1 To Len(s)
Select Case Asc(Mid(s, i, 1))
Case 48 To 57, 120, 88: FltrISBN = FltrISBN & Mid(s, i, 1)
Case Else: FltrISBN = FltrISBN & " "
End Select
Next
End Function

[mikerickson]

You could use this UDF. If your long string is in A1, put =OnlyISBN(a1) in a cell


Function OnlyISBN(longString As String) As String
Dim words As Variant, oneWord As Variant, i As Long

longString = Replace(Replace(longString, ",", vbNullString), ".", vbNullString)
words = Split(longString, " ")
For i = LBound(words) To UBound(words)
If (words(i) Like "##########") Or (words(i) Like "#############") Or (words(i) Like "#########x") Then

Else
words(i) = " "
End If
Next i

OnlyISBN = WorksheetFunction.Trim(Join(words, " "))
End Function

[lecxe]

Hi

Another option:



Function ISBNIDs(s As String) As String

With CreateObject("VBScript.RegExp")
.Pattern = ".*?\b(\d{13}|\d{10}|(\d{9}x))\b|.*"
.Global = True
ISBNIDs = Trim(.Replace(s, " $1"))
End With
End Function

[snb]

In this case:


Sub M_snb()
sn = Split(Replace(Replace("There are several books here, including 0192145789 and 9781245687456. Also, the book with isbn 045789541x is included. This book is one of 100000000 copies.", ".", " "), ",", " "))

For j = 0 To UBound(sn)
If Val(sn(j)) <> 0 Then If Len(sn(j)) = 10 Or Len(sn(j)) = 13 Then c01 = c01 & " " & sn(j)
Next

MsgBox Trim(c01)
End Sub

[lecxe]

Hi snb

Remark: you do not follow the specs. You accept, for ex., any string starting with a digit and 10 or 13 characters long.
This said it may work in most cases and it's a very simple solution.

[snb]

@lecxe

You missed the 'In this case' ?
I posted it to show an approach, not to present a solution. I only post suggestions an approach. They might turn out to be solutions but are not meant to be it.

[lecxe]

@lecxe

You missed the 'In this case' ?
I posted it to show an approach, not to present a solution. I only post suggestions an approach. They might turn out to be solutions but are not meant to be it.

Sorry snb, I understand now what you meant.