spell check for a particular cell not working

[mastermind5767]

Public Sub CheckSheetSpelling()
Dim MySheet As Object
Dim MyCell As Range
Dim i As Integer, j As Integer
Dim MySentence As String, MyWord As String
Set MySheet = Sheets("sheet1")
Set MyCell = MySheet.Range("A2")



For Each MyCell In MySheet.UsedRange
If MyCell.Value <> MyCell.Formula Then GoTo NextCell:
If Application.CheckSpelling(MyCell.Value) Then GoTo NextCell:

MySentence = " " & MyCell.Value
i = 2
While i < Len(MySentence)
If Mid(MySentence, i - 1, 1) = " " And Mid(MySentence, i, 1) <> "" Then
j = InStr(i, MySentence, " ") - 1
If j = -1 Then j = Len(MySentence)
MyWord = Mid(MySentence, i, j - i + 1)
If Not Application.CheckSpelling(MyWord) Then
With MyCell.Characters(Start:=i - 1, Length:=j - i + 1).Font
.Underline = xlUnderlineStyleNone
.Color = RGB(255, 0, 0)
End With
End If
i = j + 1
End If
i = i + 1
Wend

NextCell:
Next MyCell

End Sub

 

[sijpie]

The sub works fine on a test I did. Don't know why it should misbehave on your text.

I rewrote the code a little bit. In general try to stay clear of 'Goto LabelX" unless it is for error trapping. It makes the code harder to follow and can easily lead to bugs later on when makeing changes. And it is normally not necessary as you can see.

Also, when you post code, place it in code brackets, so it comes in a noice window and doesn't lose its indentation. See my signature line in red and blue.

Public Sub CheckSheetSpelling()
    Dim MySheet As Object
    Dim MyCell As Range
    Dim i As Integer, j As Integer
    Dim MySentence As String, MyWord As String
    
    Set MySheet = Sheets("sheet5")
    
    For Each MyCell In MySheet.UsedRange
        ' check to see if not a formula or empty
        If MyCell.Value = MyCell.Formula And MyCell <> Empty Then
            ' check if spellingcheck indicates error
            If Not Application.CheckSpelling(MyCell.Value) Then
                ' Check each word in the sentence
                MySentence = " " & MyCell.Value
                i = 2
                While i < Len(MySentence)
                    If Mid(MySentence, i - 1, 1) = " " And Mid(MySentence, i, 1) <> "" Then
                        j = InStr(i, MySentence, " ") - 1
                        If j = -1 Then j = Len(MySentence)
                        MyWord = Mid(MySentence, i, j - i + 1)
                        If Not Application.CheckSpelling(MyWord) Then
                            ' Color the word red
                            With MyCell.Characters(Start:=i - 1, Length:=j - i + 1).Font
                                .Underline = xlUnderlineStyleNone
                                .Color = RGB(255, 0, 0)
                            End With
                        End If
                        i = j + 1
                    End If
                    i = i + 1
                Wend
            End If
        End If
    Next MyCell


End Sub