View Single Post
  #3   Report Post  
Old March 20th 19, 11:02 PM posted to microsoft.public.excel.programming
Claus Busch Claus Busch is offline
external usenet poster
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,696
Default Pick up specific marked text (one or more then one) out of a cell and combine them into another

Hi Johan,

Am Wed, 20 Mar 2019 23:15:06 +0100 schrieb Claus Busch:

Sub Test()
Dim varTmp As Variant, varData As Variant, varOut() As Variant

you can also do it with Regular Expressions:

Sub Test2()
Dim varData As Variant, varOut() As Variant
Dim LRow As Long, i As Long
Dim n As Integer
Dim strTmp As String
Dim re, ptrn, Match, Matches

ptrn = "[A-Z]{1,2}[0-9]{1,6}"
Set re = CreateObject("vbscript.regexp")
re.Pattern = ptrn
re.IgnoreCase = False
re.Global = True

With ActiveSheet
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
varData = .Range("A1:A" & LRow)
For i = LBound(varData) To UBound(varData)
strTmp = ""
Set Matches = re.Execute(varData(i, 1))
For Each Match In Matches
strTmp = strTmp & ";" & Match
ReDim Preserve varOut(UBound(varData) - 1)
varOut(i - 1) = Mid(strTmp, 2)
.Range("B1").Resize(UBound(varOut) + 1) = Application.Transpose(varOut)
End With
End Sub

Claus B.
Office 2016