Underlining bottom word in Wrapped cell

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,830
Office Version
  1. 365
Platform
  1. Windows
I'm making headers for an income statement report. The headers change depending on the type of report it is. When a cell is wrapped and the words are in multiple rows I have a problem getting only the words on the bottom to underline. I can use this code, but the user has the ability to change the text in the cell and so it messes up the underline.

Code:
IncHdr.Offset(0, 3).Characters(Start:=8, Length:=9).Font.Underline = xlUnderlineStyleSingle

Is there a way to detect which words are on the bottom of the multiple lines? I'm thinking not. Only other way I can think of making it right is to have multiple rows for the words.

Better or Worse Than Budget

<tbody>
</tbody>
 

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().

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows
what happens if the last word at the bottom spans more than the last line ? like
Better or
Worse Than WWW.MrExc
el.COM

<tbody>
</tbody>
Is the integrity of the last word always contained within one line ? ie: within the last line ?
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,698
Office Version
  1. 2010
Platform
  1. Windows
what happens if the last word at the bottom spans more than the last line ? like
Better or
Worse Than WWW.MrExc
el.COM

<tbody>
</tbody>
Is the integrity of the last word always contained within one line ? ie: within the last line ?
In addition to Jaafar's question, I have a question as well... is the text in the cell a constant or is it the result of a formula in the cell?
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,830
Office Version
  1. 365
Platform
  1. Windows
Thank you.

Ok, I'm putting ownership on the end user to make sure the word or words at the bottom don't span multiple lines. They also have the freedom to choose the width. I'm running a lengthy macro that reads the cell on the "Options" sheet to fill in the headers for the report. So, It could be longer or shorter, depending on the user.

Jeff
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

This task turned out rather challenging .. I have tried different approaches including getting the pixels size of the cell's text but with no luck

The closest I have come to is to use a temporary hidden textbox, place the cell text in it and take advantage of the Lines Count Property of the TextFrame Object to localise the bottom line .. This works most of the time (Not Always) .. It starts giving inconsistent results if the text has many repetitive letters or spaces but that is unlikely

Anyway, give this sloppy workaround a shot and see what you get:
Code:
Sub UnderlineBottomWords(ByVal Cell As Range)
    Dim oShp     As Shape
    Dim lStart   As Long
    Dim lLength  As Long

    On Error GoTo err_Handler
    With Cell
        Set oShp = Cell.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        .Left, .Top, .Width, .Height)
        .Font.Underline = False
    End With
    oShp.Name = "Temp"
    With oShp.TextFrame2.TextRange
        .TEXT = Cell.TEXT
        .Font.NameAscii = Cell.Font.Name
        .Font.SIZE = Cell.Font.SIZE
        lStart = .Lines(.Lines.Count).Start
        lLength = .Lines(.Lines.Count).Length
    End With
    Cell.Characters(Start:=lStart, Length:=lLength).Font.Underline = xlUnderlineStyleSingle
    oShp.Delete
    Set oShp = Nothing
    Exit Sub
err_Handler:
    Cell.Parent.Shapes("Temp").Delete
    MsgBox "An error has occurred! " & vbLf & "Error Number: " _
    & Err.Number & vbLf & Err.Description, vbExclamation
End Sub

Public Sub Test()
    UnderlineBottomWords Sheet1.Range("a1")
End Sub
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,830
Office Version
  1. 365
Platform
  1. Windows
Thank you Jaafar. I thought maybe there was built in features for a cell to detect the number of lines. Seems only available for a textframe. I'll try it out. Seems odd though that you delete the shape before copying and pasting the text into the cell.
 

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
8,118
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Thank you Jaafar. I thought maybe there was built in features for a cell to detect the number of lines. Seems only available for a textframe. I'll try it out. Seems odd though that you delete the shape before copying and pasting the text into the cell.

If instead of having the cells wrapped, the wrapping was done manually by entering a break line via ALt+ Enter keys then one could figure out the number of lines in the cell which would be the total number of Chr(10) s - 1

The shape is deleted because copying the shape text into the wrapped cell has no effect.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,698
Office Version
  1. 2010
Platform
  1. Windows
The closest I have come to is to use a temporary hidden textbox, place the cell text in it and take advantage of the Lines Count Property of the TextFrame Object to localise the bottom line .. This works most of the time (Not Always) .. It starts giving inconsistent results if the text has many repetitive letters or spaces but that is unlikely
It might have something to do with the margins... setting them to 1 might yield better results. Here is your code modified to do that.

Code:
Sub UnderlineBottomWords(ByVal Cell As Range)
    Dim oShp     As Shape
    Dim lStart   As Long
    Dim lLength  As Long

    On Error GoTo err_Handler
    With Cell
        Set oShp = Cell.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, _
        .Left, .Top, .Width, .Height)
        .Font.Underline = False
    End With
    oShp.Name = "Temp"
    With oShp.TextFrame2
      .MarginLeft = 1
      .MarginRight = 1
      .MarginTop = 1
      .MarginBottom = 1
      With .TextRange
        .Text = Cell.Text
        .Font.NameAscii = Cell.Font.Name
        .Font.Size = Cell.Font.Size
        lStart = .Lines(.Lines.Count).Start
        lLength = .Lines(.Lines.Count).Length
      End With
    End With
    Cell.Characters(Start:=lStart, Length:=lLength).Font.Underline = xlUnderlineStyleSingle
    oShp.Delete
    Set oShp = Nothing
    Exit Sub
err_Handler:
    Cell.Parent.Shapes("Temp").Delete
    MsgBox "An error has occurred! " & vbLf & "Error Number: " _
    & Err.Number & vbLf & Err.Description, vbExclamation
End Sub

Note: Your code assumes the text in the TextBox is "normal" and uniform... if parts of it are, say, italicized or bold, then I think your code will fail a noticeable amount of times because the character widths will be different between the cell and your TextBox. Also, your code will outright crash if individual characters have a different size than the rest of the text (your Font.Size assignment will crash because the Cell's Font.Size attribute will be Null due to the mixed sizes). You could overcome this by iterating every font property for each individual character in the cell and assigning those properties to the individual character in your TextBox, but that would be time consuming, especially if there were lots of text in the cell or lots of cells needed to be processed or both.
 
Last edited:

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,830
Office Version
  1. 365
Platform
  1. Windows
Um, hey guys :/ I thought this would be a simple. Yes, I could fiddle around with that code. I like the idea of using the hard returns to force multiple lines. That should be good enough.

Now please go help less fortunate people than myself. Sheesh, go enjoy your Sunday!!! :)
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
36,698
Office Version
  1. 2010
Platform
  1. Windows
Um, hey guys :/ I thought this would be a simple. Yes, I could fiddle around with that code. I like the idea of using the hard returns to force multiple lines. That should be good enough.
With the exception of what I pointed out in my Note, I think the modification I made to Jaafar's code will make it work quite reliably, at least it did in my limited testing (hopefully when Jaafar comes back online, he will test it against the cases he pointed out his original code had problems with).


Sheesh, go enjoy your Sunday!!! :)
I am enjoying myself... besides, I am retired, every day is a Sunday for me. :)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,054
Messages
5,599,533
Members
414,315
Latest member
Yolanda5050

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