Forum Discussion
Senthilraja_Ramasamy
Dec 05, 2018Copper Contributor
Formula to split cell values to multiple cells based on condition
Is it possible to split a cell in to multiple cells based on the condition? If a cell contains a value like (A01626*A01666*6*A01656*A01696)/(A01646*100*A01676*6*1.1) in Cell A1, then is it possib...
- Dec 14, 2018
You should just be able to select the whole range you want to split and then run it. I tried it with multiple cells selected when I wrote it.
Or just use this, change Set SplitRange = Range("A1:A1000") as appropriate to the range you want to split the strings from.
Sub SplitString()
Dim Cell As Range
Dim i As Integer
Dim Position As Integer
Dim Search As String
Dim Start As Integer
Dim SplitRange As Range
Search = "A0"
Set SplitRange = Range("A1:A1000")
For Each Cell In SplitRange
i = Cell.Column + 1
Start = 1
Do
Position = InStr(Start, Cell.Text, Search, vbTextCompare)
If Position > 0 Then
Start = Position + 1
Cells((Cell.Row), i).Value = Mid(Cell.Text, Position, 6)
i = i + 1
End If
Loop While Position > 0
Next Cell
End Sub
Senthilraja_Ramasamy
Dec 14, 2018Copper Contributor
Thank you and it is working for the first cell. How the code can automatically check the whole column and split?
Much appreciated in advance.
Regards,
Senthil
JWR1138
Dec 14, 2018Iron Contributor
You should just be able to select the whole range you want to split and then run it. I tried it with multiple cells selected when I wrote it.
Or just use this, change Set SplitRange = Range("A1:A1000") as appropriate to the range you want to split the strings from.
Sub SplitString()
Dim Cell As Range
Dim i As Integer
Dim Position As Integer
Dim Search As String
Dim Start As Integer
Dim SplitRange As Range
Search = "A0"
Set SplitRange = Range("A1:A1000")
For Each Cell In SplitRange
i = Cell.Column + 1
Start = 1
Do
Position = InStr(Start, Cell.Text, Search, vbTextCompare)
If Position > 0 Then
Start = Position + 1
Cells((Cell.Row), i).Value = Mid(Cell.Text, Position, 6)
i = i + 1
End If
Loop While Position > 0
Next Cell
End Sub