Functions to separate a string separated by commas

J

jeffdolton

Board Regular
Joined
Dec 21, 2020
Messages
100
Office Version
  1. 2010
Platform
  1. Windows
Hi,

I’ve opened up another thread as my request this time is a little different. With help from experts on this forum, and using some basic excel logic, I’ve managed to separate purchase data from an EPOS system. I would like to consolidate all of this into just two functions if possible; one to show the product purchased and one to show the number of products purchased in one transaction.

The EPOS data extract shows items purchased in one transaction and the items are separated by commas, although options selected are separated by a comma within parentheses.

An example of a single transaction is:

2 x bacon bap 2 sausages, Bottled beer 500ml, 3 x Coffee (Own Cup), Polo Shirt (Navy, Large)

In this case four products have been purchased in one transaction. A weekly EPOS extract can have hundreds of rows of transactions.

I need to separate each product purchase on the same row as follows:

Selection 1. Selection 2. ..... Selection 15
Product. No Product. No. Product No.

I’ve catered for up to 15 different products being purchased under the one transaction.

As I see it the following is required:

i. Separate each product group contained within a comma (but not the option separated by a comma in brackets).
ii. Leave the comma within the parentheses as this is how a lookup table appears . If this is too difficult then these commas can stay (there can be up to three commas within brackets)
iii. Separate the first number in the product group and if there is no number return a value of 1.
iv. Remove the space x space from the selection. .

So the output should look like this.

Selection 1. Selection 2 Selection 3. S Selection 4

Product No. Product. No. Product. No. Product. No.
bacon bap 2 sausages 2 Bottled beer 500ml. 1 Coffee (Own Cup) 3 Polo Shirt ( Navy Large 1


As always, many thanks for your help.
 
Sort by date Sort by votes
Please upload your example file with XL2BB ADDIN at above of reply section OR upload it at free uploading site e.g. www.dropbox.com or googledrive or onedrive and insert link here.
For me working well.
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
try this. this one don't delete Column L. if you want to Delete it Change all number 13 to 12.
if your data is another column except L change 13 to column Number from first + 1
VBA Code: 
Sub SplitByCommaExample()

Dim MyArray() As String, MyString As String, N As Integer, j As Long
Dim Lr As Long, Lr2 As Long, a As Long, b As Long, c As Long, d As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To Lr

MyString = Range("L" & a).Value

MyArray = Split(MyString, ",")
Lr2 = Cells(Rows.Count, 1).End(xlUp).Row
For N = 0 To UBound(MyArray)
b = InStr(Trim(MyArray(N)), "(")
c = InStr(Trim(MyArray(N)), ")")
If b > 0 And c = 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1))
MyArray(N + 1) = ""
End If
    Cells(a, N * 2 + 1 + 12).Value = Trim(MyArray(N))
    If N > d Then
    d = N
    End If
Next N
Next a

For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) <> "" Then
MyArray = Split(Cells(a, j).Value, "x ")
If UBound(MyArray) = 1 Then
Cells(a, j).Value = Trim(MyArray(1))
Cells(a, j + 1).Value = Trim(MyArray(0))
ElseIf IsNumeric(Cells(a, j)) = True Then
Else
Cells(a, j + 1).Value = 1
End If
End If
Next a
Next j
For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
End If
End If
Next a
Next j


End Sub
 
Upvote 0
maabadi said:
try this. this one don't delete Column L. if you want to Delete it Change all number 13 to 12.
if your data is another column except L change 13 to column Number from first + 1
VBA Code: 
Sub SplitByCommaExample()

Dim MyArray() As String, MyString As String, N As Integer, j As Long
Dim Lr As Long, Lr2 As Long, a As Long, b As Long, c As Long, d As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To Lr

MyString = Range("L" & a).Value

MyArray = Split(MyString, ",")
Lr2 = Cells(Rows.Count, 1).End(xlUp).Row
For N = 0 To UBound(MyArray)
b = InStr(Trim(MyArray(N)), "(")
c = InStr(Trim(MyArray(N)), ")")
If b > 0 And c = 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1))
MyArray(N + 1) = ""
End If
    Cells(a, N * 2 + 1 + 12).Value = Trim(MyArray(N))
    If N > d Then
    d = N
    End If
Next N
Next a

For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) <> "" Then
MyArray = Split(Cells(a, j).Value, "x ")
If UBound(MyArray) = 1 Then
Cells(a, j).Value = Trim(MyArray(1))
Cells(a, j + 1).Value = Trim(MyArray(0))
ElseIf IsNumeric(Cells(a, j)) = True Then
Else
Cells(a, j + 1).Value = 1
End If
End If
Next a
Next j
For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
End If
End If
Next a
Next j


End Sub
Click to expand...
This is close, just one matter though please. There can be up to three options inside parentheses separated by two commas. I changed one of the transactions as follows 2 x Bacon Bap, Coffee (Filter, Paper Cup, Brown), Tea (Paper Cup) and re-ran the code. Bacon Bap was separated ok but coffee was shown as Coffee (Filter, Paper Cup in one column and Brown) in the next. Please note there would never be more than three options, two commas inside parentheses. Thank you.



Coffee (Filter, Paper Cup
Coffee (Filter, Paper Cup
 
Upvote 0
Try this. But maybe take long time to response. If have another option you can use it also.
VBA Code: 
Sub SplitByCommaExample()

Dim MyArray() As String, MyString As String, N As Integer, j As Long
Dim Lr As Long, Lr2 As Long, a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, g As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To Lr

MyString = Range("L" & a).Value

MyArray = Split(MyString, ",")
Lr2 = Cells(Rows.Count, 1).End(xlUp).Row
For N = 0 To UBound(MyArray)
b = InStr(Trim(MyArray(N)), "(")
c = InStr(Trim(MyArray(N)), ")")
On Error Resume Next
e = InStr(Trim(MyArray(N + 1)), ")")
f = InStr(Trim(MyArray(N + 2)), ")")
g = InStr(Trim(MyArray(N + 3)), ")")
If b > 0 And c = 0 Then
If e > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1))
MyArray(N + 1) = ""
ElseIf f > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1)) & ", " & Trim(MyArray(N + 2))
MyArray(N + 1) = ""
MyArray(N + 2) = ""
ElseIf g > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1)) & ", " & Trim(MyArray(N + 2)) & ", " & Trim(MyArray(N + 3))
MyArray(N + 1) = ""
MyArray(N + 2) = ""
MyArray(N + 3) = ""
End If
End If
    Cells(a, N * 2 + 1 + 12).Value = Trim(MyArray(N))
    If N > d Then
    d = N
    End If
Next N
Next a

For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) <> "" Then
MyArray = Split(Cells(a, j).Value, "x ")
If UBound(MyArray) = 1 Then
Cells(a, j).Value = Trim(MyArray(1))
Cells(a, j + 1).Value = Trim(MyArray(0))
ElseIf IsNumeric(Cells(a, j)) = True Then
Else
Cells(a, j + 1).Value = 1
End If
End If
Next a
Next j
For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
End If
End If
End If
End If
End If
End If
End If
End If

Next a
Next j


End Sub
 
Upvote 0
maabadi said:
Try this. But maybe take long time to response. If have another option you can use it also.
VBA Code: 
Sub SplitByCommaExample()

Dim MyArray() As String, MyString As String, N As Integer, j As Long
Dim Lr As Long, Lr2 As Long, a As Long, b As Long, c As Long, d As Long
Dim e As Long, f As Long, g As Long

Lr = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To Lr

MyString = Range("L" & a).Value

MyArray = Split(MyString, ",")
Lr2 = Cells(Rows.Count, 1).End(xlUp).Row
For N = 0 To UBound(MyArray)
b = InStr(Trim(MyArray(N)), "(")
c = InStr(Trim(MyArray(N)), ")")
On Error Resume Next
e = InStr(Trim(MyArray(N + 1)), ")")
f = InStr(Trim(MyArray(N + 2)), ")")
g = InStr(Trim(MyArray(N + 3)), ")")
If b > 0 And c = 0 Then
If e > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1))
MyArray(N + 1) = ""
ElseIf f > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1)) & ", " & Trim(MyArray(N + 2))
MyArray(N + 1) = ""
MyArray(N + 2) = ""
ElseIf g > 0 Then
MyArray(N) = Trim(MyArray(N)) & ", " & Trim(MyArray(N + 1)) & ", " & Trim(MyArray(N + 2)) & ", " & Trim(MyArray(N + 3))
MyArray(N + 1) = ""
MyArray(N + 2) = ""
MyArray(N + 3) = ""
End If
End If
    Cells(a, N * 2 + 1 + 12).Value = Trim(MyArray(N))
    If N > d Then
    d = N
    End If
Next N
Next a

For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) <> "" Then
MyArray = Split(Cells(a, j).Value, "x ")
If UBound(MyArray) = 1 Then
Cells(a, j).Value = Trim(MyArray(1))
Cells(a, j + 1).Value = Trim(MyArray(0))
ElseIf IsNumeric(Cells(a, j)) = True Then
Else
Cells(a, j + 1).Value = 1
End If
End If
Next a
Next j
For j = 13 To 2 * (d + 1) + 13
For a = 2 To Lr
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
If Cells(a, j) = "" Then
Cells(a, j).Delete (XlDeleteShiftDirection.xlShiftToLeft)
End If
End If
End If
End If
End If
End If
End If
End If

Next a
Next j


End Sub
Click to expand...
Thanks once again and it worked perfectly but did take a long time to run though. Are you saying that you have another option?
 
Upvote 0
maabadi said:
You're Welcome & Thanks for Feedback.
Click to expand...
Hi Maabadi,

I've decided to go with your coding, thank you. It only takes 5 minutes to run and I can live with that. It's a big ask, but are you able to modify your code so that each product and number is separated by two blank columns? The reason is that I'd like to insert two lookup formuale between the separation to provide the category of the product, for instance 'Catering' and the unit price.

Many thanks, Jeff
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
pivot table from columns with strings separated by commas
Replies
7
Views
1K
Fluff
Fluff
J
  • Solved
Removing a comma inside a parenthesis or parentheses
3 4 5
Replies
40
Views
5K
Peter_SSs
Peter_SSs
S
  • Question Question
Code to use multiple trigger cells to hide / unhide rows of corresponding question sets
Replies
1
Views
1K
dmt32
D
M
  • Solved
Help with separating Text String from a Excel Col
Replies
3
Views
593
Peter_SSs
Peter_SSs
M
  • Question Question
Help with FilterXML formula
Replies
0
Views
1K
montex01
M

Forum statistics

Threads
1,223,910
Messages
6,175,318
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top