VBA split text in columns but skip rows when there is data without spacebar used

[Pätkis]

Hey,

I have a problem with my macro below. It splits text in columns when there is space between text but it stops if there is a cell with one word / number and no space used. How can I get it skip rows, which it cannot split in columns?

Sub SplitText()
Dim StringArray() As String, Cell As Range, i As Integer
For Each Cell In Selection.Range("A1:A150")
StringArray = Split(Cell, " ")
For i = 0 To UBound(StringArray)
Cell.Offset(, i + 1) = StringArray(i)
Next i
Next
End Sub

Here is an example what it does but stops doing when there isn't space

 

[Alex Blakenburg]

Do you really intend what this line is doing though
Selection.Range("A1:A150")
It starts the range at the first cell in whatever cell or range you select and runs the macro for the next 150 rows.
So if you select E8 it runs from E8:E157

I haven't adjusted for the above comment but try this

Sub SplitText()
    Dim StringArray() As String, Cell As Range, i As Integer
    For Each Cell In Selection.Range("A1:A150")
    StringArray = Split(Trim(Cell), " ")
        If UBound(StringArray) <> 0 Then
            For i = 0 To UBound(StringArray)
                Cell.Offset(, i + 1) = StringArray(i)
            Next
        End If
    Next
End Sub

 

[Pätkis]

I changed the selection.range to be range. Thanks for that!

But the code gives me run-time error '13': Type mismatch

There is two lines in excel, which has = sign first and excel shows them as #NAME?. If I remove these two lines macro works like a dream but is there a possibility two run the macro without deleting these two lines?

 

[Alex Blakenburg]

See if this does what you need.
I am prefixing it with a single quote so it doesn't think it is a formula.

Sub SplitText()
    Dim StringArray() As String, Cell As Range, i As Integer
    For Each Cell In Range("A1:A150")
    StringArray = Split(Trim(Cell), " ")
        If UBound(StringArray) <> 0 Then
            For i = 0 To UBound(StringArray)
                If Left(StringArray(i), 1) = "=" Then
                    Cell.Offset(, i + 1) = Replace(StringArray(i), "=", "'=")
                Else
                    Cell.Offset(, i + 1) = StringArray(i)
                End If
            Next
        End If
    Next
End Sub

 

[Pätkis]

Unfortunately it is still giving the same error.

 

[Alex Blakenburg]

Can you paste into here what is in the cell to start with and also what you want as output.

This was my sample data

20210728 VBA Split skip single value.xlsm
	A	B	C	D	E
1	Hello world	Hello	world
2	Try one more	Try	one	more
3	SingleValue
4	try again	try	again
5	Formula =Test	Formula	=Test
6
Data

Cell Formulas
Range	Formula
A5	A5	= "Formula " & "=Test"

 

[Rick Rothstein]

I have modified Alex's code below - does it work correctly for you?

Sub SplitText()
  Dim StringArray() As String, Cell As Range, Rng As Range, i As Integer
  Set Rng = Selection(1).Resize(150)
  For Each Cell In Union(Rng.SpecialCells(xlConstants), Rng.SpecialCells(xlFormulas, xlTextValues))
    StringArray = Split(Trim(Cell), " ")
    If UBound(StringArray) <> 0 Then
      For i = 0 To UBound(StringArray)
        Cell.Offset(, i + 1).NumberFormat = "@"
        Cell.Offset(, i + 1) = StringArray(i)
      Next
    End If
  Next
End Sub

 

[Pätkis]

Can you paste into here what is in the cell to start with and also what you want as output.

This was my sample data

20210728 VBA Split skip single value.xlsm
	A	B	C	D	E
1	Hello world	Hello	world
2	Try one more	Try	one	more
3	SingleValue
4	try again	try	again
5	Formula =Test	Formula	=Test
6
Data

Cell Formulas
Range	Formula
A5	A5	= "Formula " & "=Test"

Hi

This is what I have and the what I would want the macro to be.

Closing Year	Closing	Year
#NAME?​	=-	Closing	Month
#NAME?​	=	Difference
Gross Tax Net	Gross	Tax	Net
1568,45 1983,21 19821,24 1 25,00 %	1568,45​	1983,21​	19821,24​	1​	25,00​	%

 

[Pätkis]

I have modified Alex's code below - does it work correctly for you?

Sub SplitText()
  Dim StringArray() As String, Cell As Range, Rng As Range, i As Integer
  Set Rng = Selection(1).Resize(150)
  For Each Cell In Union(Rng.SpecialCells(xlConstants), Rng.SpecialCells(xlFormulas, xlTextValues))
    StringArray = Split(Trim(Cell), " ")
    If UBound(StringArray) <> 0 Then
      For i = 0 To UBound(StringArray)
        Cell.Offset(, i + 1).NumberFormat = "@"
        Cell.Offset(, i + 1) = StringArray(i)
      Next
    End If
  Next
End Sub

This gives run-time error ´1004´: No cells were found.

 

[Alex Blakenburg]

This I can do easily using the code below.
If you want to split out characters that do not have the space delimiter then you are going to have to hard code quite a bit more stuff into your macro.
(I suspect difference would normally have been entered as =difference and will be caught up the single value if statement and produce nothing, here I had it entered as = difference [with a space after the equals])

20210728 VBA Split skip single value.xlsm
	A	B	C	D	E
1	Hello world	Hello	world
2	Try one more	Try	one	more
3	SingleValue
4	try again	try	again
5	Formula =Test	Formula	=Test
6	#NAME?	=-closing	month
7	#NAME?	=	difference
8	test range	test	range
9
Data

Cell Formulas
Range	Formula
A5	A5	= "Formula " & "=Test"
A6	A6	=-closing month
A7	A7	= difference
A8	A8	=RangeName

Named Ranges
Name	Refers To	Cells
RangeName	=Data!$K$1	A8

Sub SplitText()
    Dim StringArray() As String, Cell As Range, i As Integer
    Dim strCell As String
  
    For Each Cell In Range("A1:A150")
  
    If IsError(Cell) Then
        strCell = Cell.Formula
    Else
        strCell = Cell.Value
    End If
  
    StringArray = Split(Trim(strCell), " ")
        If UBound(StringArray) <> 0 Then
            For i = 0 To UBound(StringArray)
                If Left(StringArray(i), 1) = "=" Then
                    Cell.Offset(, i + 1) = Replace(StringArray(i), "=", "'=")
                Else
                    Cell.Offset(, i + 1) = StringArray(i)
                End If
            Next
        End If
    Next
End Sub