autonumber a string within a cell

[rtpathy]

Here is a sample value of a cell that contains my data

"Z_DRAWING_NUMBER : SP2422-B50-NA2101-601&602-005 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-206 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-205 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-204 ; Z_SERIAL_NUMBER : JD85087203 - 6 ; Z_SERIAL_NUMBER : JD85087203 - 5 ; Z_SERIAL_NUMBER : JD85087203 - 4 ; Z_SERIAL_NUMBER : JD85087203 - 3 ; Z_SERIAL_NUMBER : JD85087203 - 2 ; Z_SERIAL_NUMBER : JD85087203 - 1 ; Z_MODEL_NUMBER : JD85087203 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-203 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-202 ; Z_TAG_NUMBER : B50-MS1-XFR(T)-201 ;"


the string "Z_TAG_NUMBER" is repeating six times in the above cell contents. i want to extract out the z tag number to different cell. the output i want is "B50-MS1-XFR(T)-205 ; B50-MS1-XFR(T)-204 ; B50-MS1-XFR(T)-203 ; B50-MS1-XFR(T)-202 ; B50-MS1-XFR(T)-201 ;"

i have tried a for loop to attach a number to the "Z_TAG_NUMBER" so i could run a text to column, but couldnt.

to substitute Z_TAG_NUMBER with a value like $$1, $$2, $$3 (auto number with unusual special character) will help me to extract out the data.

Thanks,
Tharanipathy R

[mana]

Option Explicit

Sub test()
    Dim s As String
    Dim dic As Object
    Dim v
    Dim i As Long
    
    s = Range("a1").Value
    
    Set dic = CreateObject("scripting.dictionary")
    
    v = Split(s, ";")
    
    For i = LBound(v) To UBound(v)
        If Trim(v(i)) Like "Z_TAG_NUMBER :*" Then
            dic(i) = Trim(Split(v(i), ":")(1))
        End If
    Next
    
    If dic.Count > 0 Then
        Range("a3").Resize(dic.Count).Value = _
            WorksheetFunction.Transpose(dic.items)
    End If
            
End Sub

[rtpathy]

Thanks a lot! its working!

[rtpathy]

Thanks a lot! its working! i need all the resulting components in a single row in a adjacent columns. if source is in a1, result should be in a b1, c1, d1, etc. so i can run the same program for a batch of data in "A" column!

[mancubus]

since i have worked on it i wanted to post my solution.

thank God, i used another object.

Sub vbax_57448_find_substrings_in_a_string()
    Dim re_matches
    Dim i As Long
    
    With CreateObject("VBScript.RegExp")
        .Pattern = "Z_TAG_NUMBER\ \:\ B50\-MS1\-XFR\(T\)\-[0-9]+"
        .Global = True
        Set re_matches = .Execute(Range("A1").Value)
    End With
         
    For i = 1 To re_matches.Count
      Range("A1").Offset(i).Value = Replace(re_matches(i - 1), "Z_TAG_NUMBER : ", "")
    Next

End Sub

[mana]

Option Explicit

Sub test2()
    Dim dic As Object
    Dim c As Range
    Dim v
    Dim r As Long
    Dim i As Long
    
    Set dic = CreateObject("scripting.dictionary")
    
    For Each c In Range("a1", Range("a" & Rows.Count).End(xlUp))
        v = Split(c.Value, ";")
        r = c.Row
        For i = LBound(v) To UBound(v)
            If Trim(v(i)) Like "Z_TAG_NUMBER :*" Then
                dic(i) = Trim(Split(v(i), ":")(1))
            End If
        Next
        
        If dic.Count > 0 Then
            Range("b" & r).Resize(, dic.Count).Value = dic.items
        End If
        dic.RemoveAll
    Next
            
End Sub

[rtpathy]

Thanks a lot! great work! fulfilled my expectations!