Split Function - divide cell by string

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.

Is the pipe (`|`) character in your string or was that just to demonstrate where you want to split your string? — Samuel Everson, May 24 '21 at 11:06
Hi Samuel, this is only to demonstrate how cells should be divided — stasser, May 24 '21 at 11:15
It might be doable using `:` as the delimiter but looks to be a bit convoluted at least for my abilities - Is it possible to add the pipe, or another unique character into the string when it's added to the cell? — Samuel Everson, May 24 '21 at 11:18
Kin, this is the only solution I found so far (but unfortunately this also doesn't work). For me this issue is too heavy for more precise code attempt. — stasser, May 24 '21 at 11:24
Is the order of keys (status, min, opt etc) always the same? Are all keys always present? — Alex K., May 24 '21 at 11:27

Alex K. · Accepted Answer · 2021-05-24T11:44:10.000

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

Ron Rosenfeld · Answer 2 · 2021-05-24T12:10:28.830

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+:)|$)

Created with RegexBuddy

@stasser Replace all of the code you are using now to do the splitting and write it to an array with a call to `SplitIt`; something like `myArray = Splitit(S)` where S is the string you are trying to parse. `myArray` would now be a 1D array so would output in a Row. So something like (where `r` is the range you are splitting up): `For Each c In r : myArray = splitIt(c.Value) : c.Offset(0, 1).Resize(columnsize:=UBound(myArray)).Value = myArray : Next c` — Ron Rosenfeld, May 26 '21 at 16:39

T.M. · Answer 3 · 2021-05-24T19:21:28.173

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

edited May 24 '21 at 19:21

answered May 24 '21 at 15:01

T.M.

9,436
3
33
57

1

Nice, :+). Just a small adaptation: The resulted array will have a first empty element (because of the Pipe first character). `s = Mid(s, 2)` will solve the problem... – FaneDuru May 24 '21 at 19:03
1

Looking more attentive to the string construction, I think I will be able to create a piece of code using arrays, but without needing any character, except the case when I will need to remove some array elements (using `Filter`)... I have some time now and I will try it. Having almost all solution in my head, it should be simple. Or not...:) – FaneDuru May 25 '21 at 07:51
1

A nice addition in any case and identifying categories, too +). - Side note: Edited your `Mid(s, 2)` proposition; possible alternative: start loop with `For i = LBound(tokens) + 1 to UBound(tokens)` @FaneDuru – T.M. May 25 '21 at 13:29
1

Yes, it will be even more efective (saving a iteration...):) – FaneDuru May 25 '21 at 13:31

FaneDuru · Answer 4 · 2021-05-24T19:14:10.723

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

Helpful intro to array handling :+) Fyi tried a different approach via Split - Join - ReSplit. @FaneDuru — T.M., May 24 '21 at 17:51

JvdV · Answer 5 · 2021-05-24T12:58:06.940

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

Would have missed the regex solution(s); my late solution is confined to Split - Join - ReSplit steps :+) @JvdV — T.M., May 24 '21 at 17:53

FaneDuru · Answer 6 · 2021-05-25T10:59:20.363

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

Split Function - divide cell by string

6 Answers6