Red underline misspelt words?

Sub BadSpell()
'red underlines misspelled words in Rng
Dim Rng As Range, C As Range
Set Rng = Sheets("sheet1").Range("A1:A" & _
Sheets("sheet1").Range("A1").End(xlDown).Row)
'reset font
For Each C In Rng
With C
.Font.Underline = False
.Font.ColorIndex = xlAutomatic
End With
Next C
'red underline bad spelling
For Each C In Rng
If Not Application.CheckSpelling(C) Then
With C
.Font.Underline = xlUnderlineStyleSingle
.Font.ColorIndex = 3
End With
End If
Next C
End Sub