Extracting Text from Cell using Excel VBA - excel

Question

I am looking to extract multiple text values from a column in Excel and populate another column with these text values.
To be more specific, I am looking to extract the STLS ticket numbers.
For example, one row may contain "ABCD-4, STLS-5644, ABBD-33, STLS-421", another row may contain "ABB-567, STLS-56435" and another row may contain no STLS tickets.
What would be the best way to approach this problem?

Answer 1

You could try this code:
Option Explicit
Sub testExtract()
Dim i As Long, j As Long, jUp As Long, lFirstRow As Long, lLastRow As Long
Dim lColFrom As Long, lColTo As Long, nTicks As Long
Dim str1 As String
Dim varArray
'
' define source column number and the destination one:
'
lColFrom = 1
lColTo = 2
'
' initialize range to analyze:
'
lFirstRow = 1
lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'
' loop over the rows:
'
For i = lFirstRow To lLastRow
'
' split the string in the cell in an array:
'
varArray = Split(Cells(i, lColFrom).Value, ",")
jUp = UBound(varArray)
nTicks = 0
str1 = ""
'
' check the array element by element if we have some ticket:
'
For j = 0 To jUp
'
' trim spaces:
'
varArray(j) = Trim(varArray(j))
'
' check if we have ticks and count them:
'
If (InStr(1, varArray(j), "STLS-") > 0) Then
If (nTicks > 0) Then
str1 = str1 & ", "
End If
str1 = str1 & varArray(j)
nTicks = nTicks + 1
End If
Next
'
' save ticks:
'
If (str1 <> "") Then
Cells(i, lColTo).Value = str1
End If
Next
End Sub

Answer 2

If your Excel has the FILTERXML function (windows Excel 2013+) and the TEXTJOIN function, you don't need VBA.
You can use:
=IFERROR(TEXTJOIN(",",TRUE,FILTERXML("<t><s>" & SUBSTITUTE(A1,",","</s><s>")&"</s></t>","//s[contains(.,'STLS')]")),"")
If you don't have those functions, you can use this VBA UDF:
Option Explicit
Function getTickets(s As String, ticket As String) As String
Dim v, w, x, col As Collection, i As Long
v = Split(s, ",")
Set col = New Collection
For Each w In v
If Trim(w) Like ticket & "*" Then col.Add Trim(w)
Next w
i = 0
If col.Count = 0 Then
getTickets = ""
Else
ReDim x(col.Count - 1)
For Each w In col
x(i) = w
i = i + 1
Next w
getTickets = Join(x, ",")
End If
End Function