PDA

View Full Version : autonumber a string within a cell



rtpathy
10-17-2016, 01:53 AM
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
10-17-2016, 04:35 AM
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
10-17-2016, 04:54 AM
Thanks a lot! its working!

rtpathy
10-17-2016, 04:59 AM
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
10-17-2016, 05:14 AM
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
10-17-2016, 06:09 AM
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
10-17-2016, 06:29 AM
Thanks a lot! great work! fulfilled my expectations!