This should do it for you!


Code:
--------------------
Sub Underline4thDigit()
Dim myS As String
Dim myD As Range

For Each myD In Intersect(ActiveSheet.UsedRange, Range("D5:D" & Range("D" & rows.count).end(xlup).row))
myS = myD.Value
myD.NumberFormat = "@"
myD.Value = myS
With myD.Characters(Start:=4, Length:=1).Font
.FontStyle = "Bold"
.Color = -16776961
.Underline = xlUnderlineStyleSingle
End With
Next myD
End Sub
--------------------


--
The Code Cage Team

Regards,
The Code Cage Team
'The Code Cage' (http://www.thecodecage.com)
------------------------------------------------------------------------
The Code Cage Team's Profile: http://www.thecodecage.com/forumz/member.php?userid=2
View this thread: http://www.thecodecage.com/forumz/sh...ad.php?t=34744