Functions to separate a string separated by commas

jeffdolton

Board Regular
Joined
Dec 21, 2020
Messages
69
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.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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
 

jeffdolton

Board Regular
Joined
Dec 21, 2020
Messages
69
Office Version
  1. 2010
Platform
  1. Windows
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
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
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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
 

jeffdolton

Board Regular
Joined
Dec 21, 2020
Messages
69
Office Version
  1. 2010
Platform
  1. Windows
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
Thanks once again and it worked perfectly but did take a long time to run though. Are you saying that you have another option?
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Me Not. Maybe Others.
 

maabadi

Well-known Member
Joined
Oct 22, 2012
Messages
1,089
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
You're Welcome & Thanks for Feedback.
 

jeffdolton

Board Regular
Joined
Dec 21, 2020
Messages
69
Office Version
  1. 2010
Platform
  1. Windows
You're Welcome & Thanks for Feedback.
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
 

Watch MrExcel Video

Forum statistics

Threads
1,119,021
Messages
5,575,614
Members
412,679
Latest member
TSpan
Top