Include "00"

[Steved]

Hello from Steved

The below works fine on 4 digits ie"2542" but will delete the first 2 digits
if they are "00" so please how can I instruct using the below macro to allow
"0042" because at the moment it will delet the "00" and leave "42" yes I need
it to be please "0042"

I Thankyou.

Sub Underline4thDigit()
Dim RR As Range
Dim R As Range
Dim WS As Worksheet
Set WS = ActiveSheet
With WS
Set RR = Application.Intersect(.UsedRange, _
.Range(.Cells(5, "D"), .Cells(.Rows.Count, "D")))
End With

For Each R In RR.Cells
With R.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Color = -16776961
.Underline = xlUnderlineStyleSingle
End With
Next R
End Sub

 

[Dave Peterson]

Option Explicit
Sub Underline4thDigit()
Dim RR As Range
Dim R As Range
Dim WS As Worksheet
Set WS = ActiveSheet
With WS
Set RR = Application.Intersect(.UsedRange, _
.Range(.Cells(5, "D"), .Cells(.Rows.Count, "D")))
End With

For Each R In RR.Cells
R.NumberFormat = "@" 'text <--Added
With R.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Color = -16776961
.Underline = xlUnderlineStyleSingle
End With
Next R
End Sub

 

[Steved]

Hello from Steved

Thankyou.

Option Explicit
Sub Underline4thDigit()
Dim RR As Range
Dim R As Range
Dim WS As Worksheet
Set WS = ActiveSheet
With WS
Set RR = Application.Intersect(.UsedRange, _
.Range(.Cells(5, "D"), .Cells(.Rows.Count, "D")))
End With

For Each R In RR.Cells
R.NumberFormat = "@" 'text <--Added
With R.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Color = -16776961
.Underline = xlUnderlineStyleSingle
End With
Next R
End Sub