Sub BadSpelling()
Dim spl, cel As Range, i As Long, str As String, loc As String
For Each cel In ActiveSheet.UsedRange
cel.Style = "Normal"
If Not Application.CheckSpelling(word:=cel.Text) Then
cel.Style = "Note"
spl = Split(cel, " ")
For i = 0 To UBound(spl)
If Not Application.CheckSpelling(word:=spl(i)) Then
loc = cel.Address(False, False)
str = str & UCase(spl(i)) & vbTab & " in cell " & loc & vbNewLine
End If
Next
End If
Next cel
If str = "" Then str = "Spell Check Complete"
MsgBox str
End Sub