Forum Discussion

Senthilraja_Ramasamy's avatar
Senthilraja_Ramasamy
Copper Contributor
Dec 05, 2018
Solved

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...
Formulas and Functions
Macros and VBA
  • JWR1138's avatar
    JWR1138
    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

     

     

     

     

JWR1138's avatar
JWR1138
Iron Contributor
Dec 14, 2018

Are the strings you want to pull out always going to be 6 characters? If not what the characters do we want to exclude? Just "(" , ")" , "/" and "*" ?

 

If it is always 6 characters then here is VBA solution based on selecting the range containing the cells to be split if that works for you. If it is not always 6 characters let me know what the seperator characters need to be and I will rejig this. 

 

Sub SplitString()

Dim Cell As Range
Dim i As Integer
Dim Position As Integer
Dim Search As String
Dim Start As Integer

Search = "A0"

For Each Cell In Selection

 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's avatar
Senthilraja_Ramasamy
Copper Contributor
Dec 14, 2018

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's avatar
    JWR1138
    Iron Contributor
    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

     

     

     

     

Resources