VBA: Separate cell text to one word per line

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
Can anybody suggest a way, VBA to apply to a range of cells into one row (B2:CT2) so it's one word per line (in the same cell).

I have a code that extends the column out but it pushes all the text to one line, so it's too long.

VBA Code:
Sub AutoFitWrappedText()
    With Range("B2:CT2").EntireColumn
    .ColumnWidth = 255 ' maximum width
    .AutoFit
    End With
End Sub


Example Cell, what it says: Dog and Cat

Example Cell, what it looks like:

Code:
Do

g

an

cat

What I'm aiming for:

Code:
Dog

and

Cat

Any help is much appreciated and thank you in advance.
 

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
='User"&Char(10)&"Dashboard'!G2, so it's looking up a reference cell, not a direct hard-coded text in cell.
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
You could change the formula to
Excel Formula:
=SUBSTITUTE('User Dashboard'!G2," ",CHAR(10))
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
Hi

VBA Code:
Sub AutoFitWrapped_Formlua_Text()
Dim Rng As Range
   With Range("B2:CT2")
   .WrapText = True
        For Each Rng In .Cells
         With Rng
              If .HasFormula And Not .Formula Like "*SUBSTITUTE*" Then
              .Replace .Formula, "=SUBSTITUTE(" & Replace(.Formula, "=", "") & ","" "",CHAR(10))", xlPart, , , , False, False
              End If
          End With
         Next
         .EntireColumn.AutoFit
         .EntireRow.AutoFit
   End With
End Sub
 

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
Thank you, now of the cells will go beyond 8 width, is it the CHAR (10) that's restricting it because some of the larger words that would go past time are being wrapped. Thank you in advance!
 

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

example.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,269
Office Version
  1. 365
Platform
  1. Windows
Have you changed the formula, or are you using the code supplied by Dossfm0q in post#13?
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Check now please

Separate cell text to one word per line.gif

Before:


After:




VBA Code:
Sub AutoFitWrapped_Formlua_Text()
Application.ScreenUpdating = False
Dim Rng As Range
   With Range("B2:CT2")
  
        For Each Rng In .Cells
         With Rng
         .WrapText = False
              If .HasFormula And Not .Formula Like "*SUBSTITUTE*" Then
              .Replace .Formula, "=SUBSTITUTE(" & Replace(.Formula, "=", "") & ","" "",CHAR(10))", xlPart, , , , False, False
              End If
              .EntireColumn.AutoFit
              .WrapText = True
              .EntireColumn.AutoFit
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter

          End With
         Next
        
         .EntireRow.AutoFit
   End With
   Application.ScreenUpdating = True

End Sub
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
Also you have more option to Wrap after slash "/"


WAS.gif

Code:
' Wrap after slah "/"'
Sub AutoFitWrapped_Formlua_Text()
Application.ScreenUpdating = False
Dim Rng As Range
   With Range("B2:CT2")
  
        For Each Rng In .Cells
         With Rng
         .WrapText = False
              If .HasFormula And Not .Formula Like "*SUBSTITUTE*" Then
             ' .Replace .Formula, "=SUBSTITUTE(" & Replace(.Formula, "=", "") & ","" "",CHAR(10))", xlPart, , , , False, False
              .Replace .Formula, "=SUBSTITUTE(SUBSTITUTE(" & Replace(.Formula, "=", "") & ","" "",CHAR(10)),""/"",""/""&CHAR(10))", xlPart, , , , False, False
              End If
              .EntireColumn.AutoFit
              .WrapText = True
              .EntireColumn.AutoFit
              .HorizontalAlignment = xlCenter
              .VerticalAlignment = xlCenter

          End With
         Next
        
         .EntireRow.AutoFit
   End With
   Application.ScreenUpdating = True

End Sub
 

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
Thank you, confirmed works. beautiful code. Thanks for sharing
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
You are welcome, very very thanks for feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,123,251
Messages
5,600,541
Members
414,386
Latest member
PARAMATHMA SENTHILNATHAN

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
Top