Extend the macro to a selection of cells...

[MrBlackd]

I have the macro in the code below which runs successfully for the selected cell.
I want to extend it so as to work on a selection of cells.
I have tried with the Do Loop statement but I have not managed it.
Any help would be appreciated.


Sub Splitt()
Dim splitVals As Variant
Dim totalVals, y As Long

y = InputBox("Enter the delimiter character used (e.g., comma, semicolon, space...)")
If y = 0 Then Exit Sub

splitVals = Split(ActiveCell.Value, Chr(Asc(y)))
totalVals = UBound(splitVals)

Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals

End Sub

[Admin]

Hi

Try


Sub Splitt()

Dim splitVals As Variant
Dim totalVals, y As String
Dim i As Long, x

y = InputBox("Enter the delimiter character used (e.g., comma, semicolon, space...)")
If y = vbNullString Then Exit Sub

If Selection.Rows.Count > 1 Then
splitVals = Application.Transpose(Selection.Value2)
For i = 1 To UBound(splitVals)
x = Split(splitVals(i), y)
If UBound(x) > -1 Then
Selection.Cells(i, 1 + 1).Resize(, UBound(x) + 1) = x
End If
Next
ElseIf Selection.Cells.Count = 1 Then
x = Split(Selection.Value2, y)
If UBound(x) > -1 Then
Selection.Offset(, 1).Resize(, UBound(x) + 1) = x
End If
End If

End Sub

[MrBlackd]

Thanks for that fast reply...

It works fine on a selection of cells but if I select only 1 cell it gets stuck on
x = Split(Selection.Value2(i), y).

Also why to replace the column that the initial data exists and not place the split data in the subsequent columns?

[Admin]

Hi

Sorry, I should have tested the code before post. Anyway, I have edited the above code.

[MrBlackd]

No need to apologize, you are providing valuable help. Thanks it works as intended now!!!