Excel: underline in formula 1

[mtdew]

I have a formula:

=" (3) The cash sales price of the leased property is "&TEXT(L19,"$###,###.##")

And I need the $###,###.## to be underlined.

I right clicked on the sheet name and clicked on View Code and inserted

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s1 As String, s2 As String

' only if L19 changes
If Target.Address <> "$L$19" Then Exit Sub

' write the text in N1
s1 = " (3) The cash sales price of the leased property is "
s2 = s1 & Range("L19") & s2



End Sub

But how do I add the underline to only the $###,###.## part? I tried taking it to another cell formatted for underlining but it wasn't underlined when I added it to the text.

Can it be done?

 

[SkipVought]

Hi,

Turn on your macro recorder and record the following steps...
[tt]
1. Select the cell containing the formula.
2. COPY
3. EDIT > PASTE SPECIAL -- VALUES
4. Select the text portion you want underlined.
5. Select the UNDERLINE
[/tt]
Post your recorded code to get help customizing.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mtdew]

Sub Underline3()
'
' Underline3 Macro
' Underline item 3
'

'
Range("A20:I20").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
" (3) The cash sales price of the leased property is -$5,000."
With ActiveCell.Characters(Start:=1, Length:=56).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=57, Length:=6).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With ActiveCell.Characters(Start:=63, Length:=1).Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("A21").Select
End Sub

 

[SkipVought]

This code assumes that
1. you have SELECTED the range you want to process
2. there is ONLY ONE dollar amount

Sub Underline3()
    Dim p1 As Integer, p2 As Integer, i As Integer, r As Range
    With Selection
        .Copy
        .PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        For Each r In .Cells
            With r
                p1 = InStrRev(.Value, "$")
                If p1 > 0 Then
                    For i = p1 To Len(.Value)
                        Select Case Mid(.Value, i, 1)
                            Case "0" To "9", ",", "$"
                            Case Else
                                p2 = i
                                Exit For
                        End Select
                    Next
                    .Characters(Start:=p1, Length:=p2 - p1).Font.Underline = xlUnderlineStyleSingle
                End If
            End With
        Next
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

I notice that your requirement includes cents...

Sub Underline3()
    Dim p1 As Integer, p2 As Integer, i As Integer, r As Range
    With Selection
        .Copy
        .PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        .Font.Underline = xlUnderlineStyleNone
        For Each r In .Cells
            With r
                p1 = InStrRev(.Value, "$")
                If p1 > 0 Then
                    For i = p1 To Len(.Value)
                        Select Case Mid(.Value, i, 1)
                            Case "0" To "9", ",", "$"
                            Case "."
                                Select Case Mid(.Value, i + 1, 1)
                                    Case "0" To "9"
                                    Case Else
                                        p2 = i
                                        Exit For
                                End Select
                            Case Else
                                p2 = i
                                Exit For
                        End Select
                    Next
                    .Characters(Start:=p1, Length:=p2 - p1).Font.Underline = xlUnderlineStyleSingle
                End If
            End With
        Next
    End With
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mtdew]

How would I modify the code to look for more than one dollar amount on the same line?

And also how would I tell the code to search for the range A20-A31 and underline all dollar amounts?

Thanks for all your help!

 

[mtdew]

I tried modifying the code with more than one cell choosen but apparently PasteSpecial won't work with multiple cells?

Sub Underline3()
Dim p1 As Integer, p2 As Integer, i As Integer, r As Range
Range("J32,A20:I20,A22,A23,A26,A31,A41,A44").Select
Range("A31").Activate.Copy
.PasteSpecial _
Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
.Font.Underline = xlUnderlineStyleNone
For Each r In .Cells
With r
p1 = InStrRev(.Value, "$")
If p1 > 0 Then
For i = p1 To Len(.Value)
Select Case Mid(.Value, i, 1)
Case "0" To "9", ",", "$"
Case "."
Select Case Mid(.Value, i + 1, 1)
Case "0" To "9"
Case Else
p2 = i
Exit For
End Select
Case Else
p2 = i
Exit For
End Select
Next
.Characters(Start:=p1, Length:=p2 - p1).Font.Underline = xlUnderlineStyleSingle
End If
End With
Next
End With
End Sub

 

[SkipVought]

Sub Underline3()
    Dim p1 As Integer, p2 As Integer, i As Integer, r As Range
    With Range("J32,A20:I20,A22,A23,A26,A31,A41,A44")
       .Copy
...

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[mtdew]

Thank you so very much. Everything you have provided to me has worked so very well. Now a question I bet is absolutely not possible.

The range I gave you calculates off other cells. I just thought, what if, after underlining, someone decides to change a number which should change the underlined numbers but now it won't, because we prepared it to be underlined.

Is there a way to reverse the process?

And sorry - I know this is overstepping but I tried thinking it through myself and I thought the best you could do would be to copy the original formula before underlining off to the side and then have the macro triggered if numbers were changed so that the original formula could be copied back, with no underlining, and then the user would have to activate the underlining feature again.

 

[SkipVought]

what if, after underlining, someone decides to change a number...

You could lock those cells and PROTECT the sheet, to prevent user changes.

You could run the underline routine on the changed cell.

You could have a copy of the entire sheet, with formulas, in order to restore to the original version.

What are the real requirements?


Skip,

_{Just traded in my old subtlety...
for a NUANCE!}