Find data in string of text

[joelkoch]

I have a column of cells that have a bunch of text in them. in that text there are serial numbers I would like to extract. A cell could have multiple different serial numbers that need to be extracted. For example a cell could have: "Exchange + PS43138 Exchange + PS43178" I'm interested in trying to get both the serial numbers out PS43138 and PS43178. the serial numbers differ slightly, but they all have a 5 digit string of numbers. I tried to create a UDF but can'f figure out how to get all serial numbers out, I can only get the first one. This is the UDF I got from the looking through the forum.

Function FiveDigitNo(s As String) As StringWith CreateObject("VBScript.RegExp")
  .Pattern = "(?:^|\D)(\d{5})(?!\d)"
  If .Test(s) Then FiveDigitNo = .Execute(s)(0).SubMatches(0)
End With
End Function

Any help would be much appreciated.

Thanks,

 

[MoshiM]

What about this

better yet

Sub h()Dim STR As String, STR_INTE As String, Array_String() As Variant, Final_String() As String, x As Long, Item As varaint, Apple As Variant


Set WK = ActiveWorkbook.Worksheets("Data")


STR = WK.Range("H2:H" & WK.UsedRange.Columns.Count).value2


ReDim Final_String(1 To 1, 1 To UBound(STR, 1))


For Each Item In STR


    STR_INTE = Item
    
    For a = 1 To Len(Item)
    
        If IsNumeric(Mid(Item, a, 1)) = False Then
        
            STR_INTE = Replace(Item, Mid(Item, a, 1), Chr(182), a, 1)
            
        End If
        
    Next a
    
    Array_String = Split(STR_INTE, Chr(182))
    
    For Each Apple In Array_String
        x = x + 1
        If Len(Apple) = 5 Then Final_String(x) = Final_String(x) & Apple
        
    Next Apple
    
Next Item
WK.Range("T2:T" & WK.UsedRange.Columns.Count).value2 = Final_String
End Sub

 

[pgc01]

Hi Joel

Going back to your post #1 , just a tweak in your code:

Function FiveDigitNo(S As String) As String

With CreateObject("VBScript.RegExp")
  .Pattern = ".*?(\d{5})(?!\d)|.*"
  .Global = True
  If .Test(S) Then FiveDigitNo = Trim(.Replace(S, " $1"))
End With
End Function