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

Pätkis

New Member
Joined
Jan 30, 2019
Messages
11
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
1627452769033.png
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
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
VBA Code:
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
 
Upvote 0
I changed the selection.range to be range. Thanks for that!

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


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?
 
Upvote 0
See if this does what you need.
I am prefixing it with a single quote so it doesn't think it is a formula.

VBA Code:
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
 
Upvote 0
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
ABCDE
1Hello worldHelloworld
2Try one moreTryonemore
3SingleValue
4try againtryagain
5Formula =TestFormula=Test
6
Data
Cell Formulas
RangeFormula
A5A5= "Formula " & "=Test"
 
Upvote 0
I have modified Alex's code below - does it work correctly for you?
VBA Code:
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
 
Upvote 0
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
ABCDE
1Hello worldHelloworld
2Try one moreTryonemore
3SingleValue
4try againtryagain
5Formula =TestFormula=Test
6
Data
Cell Formulas
RangeFormula
A5A5= "Formula " & "=Test"
Hi

This is what I have and the what I would want the macro to be.
Closing YearClosingYear
#NAME?​
=-ClosingMonth
#NAME?​
=Difference
Gross Tax NetGrossTaxNet
1568,45 1983,21 19821,24 1 25,00 %
1568,45​
1983,21​
19821,24​
1​
25,00​
%
 
Upvote 0
I have modified Alex's code below - does it work correctly for you?
VBA Code:
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.
1627463123334.png
 
Upvote 0
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
ABCDE
1Hello worldHelloworld
2Try one moreTryonemore
3SingleValue
4try againtryagain
5Formula =TestFormula=Test
6#NAME?=-closingmonth
7#NAME?=difference
8test rangetestrange
9
Data
Cell Formulas
RangeFormula
A5A5= "Formula " & "=Test"
A6A6=-closing month
A7A7= difference
A8A8=RangeName
Named Ranges
NameRefers ToCells
RangeName=Data!$K$1A8



VBA Code:
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
 
Upvote 0
Solution

Forum statistics

Threads
1,213,557
Messages
6,114,291
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top