Split Function - divide cell by string - excel

Question

I am trying to divide merged information from one cell into separate cells.
one cell:
amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750
divided data: (I want to export each part into another cell)
amount:2
price:253,18
price2:59,24 EU
status:WBB NAS MRR OWA PXA
min:1
opt:3
category: PNE
code z:195750
I can't simply divide by finding empty space, status cell which is case-sensitive | status:WBB NAS MRR OWA PXA| has a different data range with spaces that can't be divided.
Split ( expression [,delimiter] [,limit] [,compare] )
Sub Split_VBA()
'Create variables
Dim MyArray() As String, MyString As String, N As Integer, Temp As String
MyString = B2 ' TRYING TO GET DATA FROM CELL B2 TO SPLIT IT
'Use the split function to divide the string using a string "price:"
MyArray = Split(MyString, "price:")
Dim arr() As String
' Split the string to an array
arr = Split(B2, "price:") 'try to divide first part of data when appears string 'price:'
For N = 0 To UBound(MyArray)
'place each array element plus a line feed character into a string
Temp = Temp & MyArray(N) & vbLf
Next N
' I WOULD LIKE TO PROVIDE RESULT IN A ROW NOT IN A COLUMN
Range("A1") = Temp
End Sub
So far this VBA code seems to be a little above my abilities and as far as I checked some online available samples, tried to provide code as below, but I just got stuck and I hereby ask you dear community for some piece of advice.

Answer 1

As the order is the same one way is to simply search for adjacent key names & parse out whats in-between:
Sub g()
Dim stringValue As String
stringValue = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
Debug.Print getPart(stringValue, "amount", "price")
Debug.Print getPart(stringValue, "price", "price2")
Debug.Print getPart(stringValue, "price2", "status")
Debug.Print getPart(stringValue, "status", "min")
Debug.Print getPart(stringValue, "min", "opt")
Debug.Print getPart(stringValue, "opt", "category")
Debug.Print getPart(stringValue, "category", "code z")
Debug.Print getPart(stringValue, "code z", "", True)
End Sub
Function getPart(value As String, fromKey As String, toKey As String, Optional isLast As Boolean = False) As String
Dim pos1 As Long, pos2 As Long
pos1 = InStr(1, value, fromKey & ":")
If (isLast) Then
pos2 = Len(value)
Else
pos2 = InStr(pos1, value, toKey & ":")
End If
getPart = Trim$(Mid$(value, pos1, pos2 - pos1))
End Function
amount:2
price:253,18
price2:59,24 EU
status:WBB NAS MRR OWA PXA
min:1
opt:3
category: PNE
code z:19575

Answer 2

Several choices:
The pattern you show is that each split can be determined by a single word (no spaces) followed by a colon.
This can be easily replicated as a regular expression pattern, and implemented in VBA.
However, if your splitword might have a space, then you'll need a different solution:
VBA Regex Solution
'Set Reference to Microsoft VBScript Regular Expressions 5.5
Option Explicit
Function splitIt(S)
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim vResult As Variant, I As Long
Const sPat As String = "\w+:.*?(?=(?:\w+:)|$)"
Set RE = New RegExp
With RE
.Global = True
.Pattern = sPat
If .Test(S) = True Then
Set MC = .Execute(S)
ReDim vResult(1 To MC.Count)
I = 0
For Each M In MC
I = I + 1
vResult(I) = M
Next M
Else
vResult = "split pattern not present"
End If
End With
splitIt = vResult
End Function
This function outputs a horizontal array of values. In versions of Excel with dynamic arrays, this will Spill into the adjacent cells. In older versions, you may have to enter it as an array formula; use INDEX for each element; or rewrite this as a Sub to output to the specific cells
Split on word: regex explanation
\w+:.*?(?=(?:\w+:)|$)
Match a single character that is a “word character” \w+
Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
Match the colon character :
Match any single character that is NOT a line break character .*?
Between zero and unlimited times, as few times as possible, expanding as needed (lazy) *?
Assert that the regex below can be matched starting at this position (positive lookahead) (?=(?:\w+:)|$)
Match this alternative (?:\w+:)
Match the regular expression below (?:\w+:)
Match a single character that is a “word character” \w+
Between one and unlimited times, as many times as possible, giving back as needed (greedy) +
Match the colon character :
Or match this alternative $
Assert position at the very end of the string $
Created with RegexBuddy

Answer 3

Split - Join - ReSplit
Instead of coding fixed categories, this late approach reads in any category from the base string before executing Split actions (only exception code z will be treated in an extra step):
1 define delimiters
2 tokenize base string (split action via blanks " ") and prefix a Pipe character "|" to the joined category elements
3 return results array via an eventual Pipe Split
Function getParts(ByVal s As String)
'Purpose: split into categories (identified by colon character ":")
'1. a) define delimiters
Const Blank$ = " ", Colon$ = ":", Pipe$ = "|", Xtra$ = "^"
' b) provide for category exception "code z" (the only two words category)
s = Replace(s, "code z", "code" & Xtra & "z")
'2. a) tokenize base string
Dim tokens: tokens = Split(s, Blank)
' b) prefix all ":" elements by Pipe char "|"
Dim i As Long
For i = 0 To UBound(tokens) '
tokens(i) = IIf(InStr(1, tokens(i), Colon), Pipe, Blank) & tokens(i)
Next
' c) restore mutilated "code z" category (back from "code^z")
s = Replace(Join(tokens, vbNullString), Xtra, Blank)
'3. get results array via Pipe split
getParts = Split(Mid$(s,2), Pipe) ' edited due to FaneDurus comment
End Function

Answer 4

I'd look into some regular expression, for example:
[a-z\d ]+:[ ,A-Z\d]+
See an online demo
[a-z\d ]+ - 1+ Lowercase alpha, space, or digit chars.
: - A literal colon.
[ ,A-Z\d]+ - 1+ Space, comma, uppercase alpha or digit.
VBA:
Sub Test()
Dim str As String: str = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
Dim matches As Object
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[a-z\d]+(?: [a-z\d]+)?:[ ,A-Z\d]+"
If .Test(str) = True Then
Set matches = .Execute(str)
For Each match In matches
Debug.Print Trim(match)
Next
End If
End With
End Sub

Answer 5

A version with a similar logic as Alex K.'s answer, so all the credit goes to him, using two arrays and the processing result being dropped on a row:
Sub extractFromString()
Dim arrStr, arrFin, strInit As String, i As Long, iStart As Long, iEnd As Long, k As Long
strInit = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
arrStr = Split("amount:,price:,price2:,status:,min:,opt:,category:,code z:", ",")
ReDim arrFin(UBound(arrStr))
For i = 0 To UBound(arrStr)
iStart = InStr(strInit, arrStr(i))
If i <> UBound(arrStr) Then
iEnd = InStr(iStart, strInit, arrStr(i + 1))
Else
arrFin(k) = Mid(strInit, iStart): Exit For
End If
arrFin(k) = RTrim(Mid(strInit, iStart, iEnd - iStart)): k = k + 1
Next i
'use here the first cell of the row where the processing result to be returned
Range("A22").Resize(1, UBound(arrFin) + 1) = arrFin
End Sub

Answer 6

Another version of split/join/filter arrays:
Sub extractFromStr()
Dim arrStr, arrFin, strInit As String, i As Long, k As Long
Dim arr1, arr2, firstEl As String, secEl As String
strInit = "amount:2 price:253,18 price2:59,24 EU status:WBB NAS MRR OWA PXA min:1 opt:3 category: PNE code z:195750"
arrStr = Split(strInit, ":") 'split the string by ":" character
ReDim arrFin(UBound(arrStr)) 'ReDim the final array at the same number of elements
For i = 0 To UBound(arrStr) - 1 'iterate between the array elements (except the last)
arr1 = Split(arrStr(i), " ") 'split the i element by space (" ")
arr2 = Split(arrStr(i + 1), " ") 'split the i + 1 element by space (" ")
If i = 0 Then 'for the first array element:
firstEl = arrStr(i) 'it receives the (first) array element value
Else 'for the rest of array elements:
'extract firstEl (category) like first arr1 element, except the case of 'code z' which is extracted in a different way
firstEl = IIf(i = UBound(arrStr) - 1, arr1(UBound(arr1) - 1) & " " & arr1(UBound(arr1)), arr1(UBound(arr1)))
End If
'in order to remove array elements, the code transformes the one to be removed in "|||":
'it could be anything, but "|||" is difficult to suppose that it will be the text of a real element...
arr2(UBound(arr2)) = "|||": If i = UBound(arrStr) - 2 Then arr2(UBound(arr2) - 1) = "|||"
'extract the secEl (the value) by joining the array after removed firstEl:
secEl = IIf(i = UBound(arrStr) - 1, arrStr(UBound(arrStr)), Join(Filter(arr2, "|||", False), " "))
arrFin(k) = firstEl & ":" & secEl: k = k + 1 'create the processed element of the array to keep the result
Next i
'use here the first cell of the row where the processing result to be returned. Here, it returns on the first row:
Range("A1").Resize(1, UBound(arrFin) + 1) = arrFin
End Sub