Split Cells using delimiter(s) to multiple columns in VBA

[Amms123]

Hi, I hope you can help me out, I'm pretty new to VBA coding and the code below works great for Spliting Cells using a single delimiter to multiple columns. However, I was hoping to modify the code so it would allow me to Split Cells using more than delimiter to multiple columns in VBA, such as "," "&" "/" etc. Unfortunately I'm at a loss and would be grateful for any assistance on this problem. Many thanks Amms123

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select a range", "", xAddress, , , , , 8)
Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count > 1 Then
'MsgBox "You can't select multiple columns", , ""
'Exit Sub
End If
Set xRg1 = Application.InputBox("Split to (single cell):", "", , , , , , 8)
Set xRg1 = xRg1.Range("A1")
If xRg1 Is Nothing Then Exit Sub
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For Each xCell In xRg
xRet = Split(xCell.Value, "&")
xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
Next
Application.ScreenUpdating = xUpdate
End Sub

 

[Amms123]

Opppps ……. I missed the most import part of my question, it should say, "

Split Cells using more than one (1) delimiter to multiple columns in VBA" Thanks again Amms123​

 

[Rick Rothstein]

It is not clear to me what your code should be doing. If I select some contiguous cells down a single column (say C5:C9), then the output is only the last cell (C9) split downward (all in the same column).

Can you describe in words what the user should select (give an example with actual text) and what the output for that example should be (what cells)?

 

[Amms123]

Yeah, no problem, below is an example of the contents in the cells I want to split into single cells, as you can see some cells have single text and other cells have multiple text, separated with a delimiter and the delimiters vary from "&" or ",".
85-V-2001
85-V-2002
85-V-2003
85-V-2004
85-V-2005
93-V-0101 & 93-V-0301
93-V-0102 & 93-V-0302
93-V-0103 & 93-V-0303
93-V-0104 & 93-V-0304
93-V-1001
93-V-1016, 93-V-1017,
93-V-1018 & 93-V-1019



The vba code below works well when splitting text with a single delimiter, for example the below output shows the cell contents getting split for the delimiter "&". However, when it comes to a cell with varying delimiters, such as "&" and "," I was trying to modify the code to simultaneously split the multi delimiter cell contents into single cells. Please use the code below, because I discovered an error in my initial post. I hope this explanation is easier to understand. Thanks Amms123
85-V-2001
85-V-2002
85-V-2003
85-V-2004
85-V-2005
93-V-0101
93-V-0301
93-V-0102
93-V-0302
93-V-0103
93-V-0303
93-V-0104
93-V-0304
93-V-1001
93-V-1016, 93-V-1017,
93-V-1018
93-V-1019

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select a range", "Kutools for Excel", xAddress, , , , , 8)
Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count > 1 Then
'MsgBox "You can't select multiple columns", , "Kutools for Excel"
'Exit Sub
End If
Set xRg1 = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
Set xRg1 = xRg1.Range("A1")
If xRg1 Is Nothing Then Exit Sub
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For Each xCell In xRg
xRet = Split(xCell.Value, "&")
xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
I = I + UBound(xRet, 1) + 1
Next
Application.ScreenUpdating = xUpdate
End Sub

 

[Rick Rothstein]

Assuming the sample data you posted is truly representative of your actual data, does this macro do what you want...

[table="width: 500"]
[tr]
	[td]Sub SplitAll()
  Dim X As Long, DataRange As Range, OutputCell As Range, ColAsText As String, Arr As Variant
  Set DataRange = Application.InputBox("Please select a range to process", "Kutools for Excel", Selection.Address, , , , , 8)
  Set OutputCell = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
  ColAsText = Join(Application.Transpose(DataRange))
  For X = 1 To Len(ColAsText)
    If Mid(ColAsText, X, 1) Like "[!A-Z0-9-]" Then Mid(ColAsText, X) = " "
  Next
  ColAsText = Application.Trim(ColAsText)
  Arr = Split(ColAsText)
  OutputCell.Resize(1 + UBound(Arr)) = Application.Transpose(Arr)
End Sub[/td]
[/tr]
[/table]

 

[Amms123]

Hi, thanks for replying so quickly but unfortunately I get a "Run-time error '5': Invalid procedure call or argument

On debugging it falls on the following part of the code "ColAsText = Join(Application.Transpose(DataRange))"

 

[Rick Rothstein]

Hi, thanks for replying so quickly but unfortunately I get a "Run-time error '5': Invalid procedure call or argument

On debugging it falls on the following part of the code "ColAsText = Join(Application.Transpose(DataRange))"

What version of Excel are you using?

 

[Amms123]

Excel 2016

 

[Rick Rothstein]

Excel 2016

I am using Excel 2010, so the code should work in your version as well. The only way I can think of to produce the error that you got was to pick more than one column for the data range... did you do that by any chance? I got the impression that you were going to process only one column at a time... am I wrong in that impression?

 

[Amms123]

Yes, I was selecting a range of columns at one time. However, most of the time the columns would only contain one row of data.