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]

Tell me if this works(untested). if I made it properly then there is a check to make sure that if you happened to have a string of numbers longer than 5 then it would simply ignore it and move on to the next block of numbers.

Sub LoopThroughString() 
Dim Counter As Long, STR_5 As String, F(CA, 1) As String, WK As Worksheet, F() As Variant, CA As Long, CB As Long, control_1 As Boolean, control_2 As Boolean, _
Count As Long, X As Long, M As Long, NCount As Long


Set WK = ActiveWorkbook.Worksheets("Data")


F = WK.Range("H2:H" & WK.UsedRange.Columns.Count).value2: CB = 1


Do While control_1 = False
    
    If control_2 = False Then control_1 = True
    
    For CA = 1 To UBound(F, 1)
    
        For Counter = 1 To Len(MyString)
        
            If IsNumeric(Mid(F(CA, 1), Counter, 1)) Then
                'get the length of the numbers just in case X MOD 5 =0
                
                For X = Counter To Len(MyString)
                     
                     If IsNumeric(Mid(F(CA, 1), X, 1)) Then
                        
                        NCount = NCount + 1: Next X
                     
                     End If
                     
                     If IsNumeric(Mid(F(CA, 1), X, 1)) = False Then Exit For
                     
                Next X
                
                If NCount <> 5 Then Counter = Counter + (NCount - 1): NCount = 0: Next Counter
                
                If IsNumeric(Mid(F(CA, 1), Counter, 5)) And IsNumeric(Mid(F(CA, 1), Counter + 5, 1)) = False Then
                'if uninterupted block of 5 numbers and the 6th character after the start of the block is not a number
                    
                    If control_2 = False Then Count = Count + 1
                    
                    If control_2 = True Then
                    
                        F(CA, CB) = Mid(F(CA, 1), Counter, 5)
    
                        CB = CB + 1
                        
                        If CB = UBound(F, 2) + 1 Then CB = 1
                        
                    End If
                    
                End If
                 
                 Counter = Counter + (NCount - 1): NCount = 0
                 
            End If
            
        Next Counter
        
            If control_2 = True Then
            
                For X = LBound(F, 2) To UBound(F, 2)-1
                
                    F(CA, 1) = F(CA, X) & " " & F(CA, X + 1)
                    
                Next X
                
            End If
            
    Next CA
    
    If control_1 = False Then control_2 = True: ReDim Preserve F(1 To UBound(F, 1), 1 To Count)
    
Loop
WK.Range("T2:T" & WK.UsedRange.Columns.Count).value2 = WorksheetFunction.Index(F, 0, 1)
 
End Sub

 

[MoshiM]

Tell me if this works(untested). if I made it properly then there is a check to make sure that if you happened to have a string of numbers longer than 5 then it would simply ignore it and move on to the next block of numbers.

made some noticeable errors

Sub LoopThroughString() 
Dim Counter As Long, STR_5 As String, F(CA, 1) As String, WK As Worksheet, F() As Variant, CA As Long, CB As Long, control_1 As Boolean, control_2 As Boolean, _
Count As Long, X As Long, M As Long, NCount As Long


Set WK = ActiveWorkbook.Worksheets("Data")


F = WK.Range("H2:H" & WK.UsedRange.Columns.Count).value2: CB = 1


Do While control_1 = False
    
    If control_2 = False Then control_1 = True
    
    For CA = 1 To UBound(F, 1)
    
        For Counter = 1 To Len(MyString)
        
            If IsNumeric(Mid(F(CA, 1), Counter, 1)) Then
                'get the length of the numbers just in case X MOD 5 =0
                
                For X = Counter To Len(MyString)
                     
                     If IsNumeric(Mid(F(CA, 1), X, 1)) Then
                        
                        NCount = NCount + 1: Next X
                     
                     End If
                     
                     If IsNumeric(Mid(F(CA, 1), X, 1)) = False Then Exit For
                     
                Next X
                
                If NCount <> 5 Then
                
                    Counter = Counter + (NCount - 1): NCount = 0: Next Counter
                    
                End If
                
                If IsNumeric(Mid(F(CA, 1), Counter, 5)) And IsNumeric(Mid(F(CA, 1), Counter + 5, 1)) = False Then
                'if uninterupted block of 5 numbers and the 6th character after the start of the block is not a number
                    
                    If control_2 = False Then Count = Count + 1
                    
                    If control_2 = True Then
                    
                        F(CA, CB) = Mid(F(CA, 1), Counter, 5)
    
                        CB = CB + 1
                        
                        If CB = UBound(F, 2) + 1 Then CB = 1
                        
                    End If
                    
                End If
                 
                 Counter = Counter + (NCount - 1): NCount = 0
                 
            End If
            
        Next Counter
        
            If control_2 = True Then
            
                For X = LBound(F, 2) To UBound(F, 2)
                
                    F(CA, 1) = F(CA, X) & " " & F(CA, X + 1)
                    
                Next X
                
            End If
            
    Next CA
    
    If control_1 = False Then
        
        control_2 = True: ReDim Preserve F(1 To UBound(F, 1), 1 To Count)
    
    End If
    
Loop
WK.Range("T2:T" & WK.UsedRange.Columns.Count).value2 = WorksheetFunction.Index(F, 0, 1)
 
End Sub

 

[joelkoch]

Thanks kweaver.

This works at pulling out all the text from the cells which is great, but in some cases the serial number has numbers before letters. Fore example 21US78274. I was hoping there was a way to pull just the 78274 out of that.

I'm trying to extract data from a field that people are allowed to type whatever they want and occasionally they put excess information in like date, or other numbers. That's why I was just trying to isolate those 5 digits in a row as that is the only thing that I can find is unique about the serial numbers.

I'm definitely saving this formula though, as I'm sure this will come in handy. My company has a lot of bad processes that we are trying to improve.

 

[joelkoch]

MoshiM,

I tried to run the macro, but i get a "Compile Error: Constant Expression Required" it highlights the red text at the beginning of your code:

Dim Counter As Long, STR_5 As String, F(CA, 1) As String, WK As Worksheet, F() As Variant, CA As Long, CB As Long, control_1 As Boolean, control_2 As Boolean, _Count As Long, X As Long, M As Long, NCount As Long

 

[kweaver]

Joel -- it would be helpful to know all of the parameters before any of us go off for some amount of time and write code! What other surprise conditions might apply?

 

[Rick Rothstein]

Joel -- it would be helpful to know all of the parameters before any of us go off for some amount of time and write code! What other surprise conditions might apply?

I agree with kweaver... it would be helpful if you tell us what you know about the text containing the serial numbers and about the serial numbers themselves. For example...

1) Could there be any 5 or more digit numbers in the text that are not serial numbers?

2) Is there always at least one letter in front of the 5-digit serial number?

3) Do you only want the 5 digits (your first message seemed to indicate you wanted the text before the serial number)?

4) Anything else that would help us in identifying what you consider to be a serial number... remember, we know absolutely nothing about your data or how you want it presented back to you... we only know what you tell us and nothing more (so don't assume we can figure it out if you forget to tell us... we can't).

 

[joelkoch]

Kweaver,

Sorry for the confusion, the only constant between the data in the columns is that the serial numbers all end with a 5 digit number. This 5 digit number in the text string is what I'm trying to isolate. The filed is pulled from a system that allows free text so there is a lot of noise that can show up. There are dates, general comments, model numbers, etc. However, Each serial number has a string of 5 consecutive numbers at the end. Each cell may have multiple serial numbers in it so I need to be able to pull out multiple serial numbers from a single cell. Since the serial numbers, in general are all different I know it is not possible to pull the entire serial number, so I'm hoping it is possible to pull out all the unique 5 digit numbers from each serial number.

Let me know if this is not clear.

Thanks again for your help on this Kweaver and MoshiM.

 

[joelkoch]

1) No only the 5 digit numbers. The serial number could be something along the line of 25LV25746 for example. I'm looking only for the final 25746.
2) In some cases there are letters before the serial number, but not in every case
3) Only the 5 digits is necessary since serial numbers do not have a consistent length or format (aside from ending in 5 digit number)
4) I believe my last post should explain the situation a little more clear.

Thanks again for the help.

 

[MoshiM]

1) No only the 5 digit numbers. The serial number could be something along the line of 25LV25746 for example. I'm looking only for the final 25746.
2) In some cases there are letters before the serial number, but not in every case
3) Only the 5 digits is necessary since serial numbers do not have a consistent length or format (aside from ending in 5 digit number)
4) I believe my last post should explain the situation a little more clear.

Thanks again for the help.

What about this

Sub Find_5()
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(STR)
    
        If IsNumeric(Mid(Item, a, 1)) = False Then
            STR_INTE = Replace(Item, Mid(Item, a, 1), "@!^&_##(^798$)-**", a, 1)
        End If
        
    Next a
    
    Array_String = Split(STR_INTE, "@!^&_##(^798$)-**")
    
    For Each Apple In Array_String
        x = x + 1
        If Len(Apple) = 5 Then Final_String(x) = Final_String(x) & " " Apple
         if x=1 then Final_String(x)=replace(Final_String," ",vbnullstring,1)
    Next Apple
     x=0
Next Item
WK.Range("T2:T" & WK.UsedRange.Columns.Count).value2 = Final_String
End Sub

 

[Rick Rothstein]

This function should return all the serial numbers in the text passed into it delimited by a single space...

Function GetSerialNumbers(ByVal S As String) As String
  Dim X As Long, Nums As Variant
  For X = 1 To Len(S)
    If Mid(S, X, 1) Like "[!0-9]" Then Mid(S, X) = " "
  Next
  Nums = Split(S)
  For X = 0 To UBound(Nums)
    If Len(Nums(X)) <> 5 Then Nums(X) = ""
  Next
  GetSerialNumbers = Application.Trim(Join(Nums))
End Function