Spell check unlocked cells with highlighting

[sparky2205]

Hi folks,
this is one of those ones where there is a lot of chatter out there about it but I haven't been able to get a fix for my issue.
My issue:
I want a macro that performs a spell check on the unlocked cells only on a protected sheet while highlighting the cell where the error occurs.
What I have so far is:

Sub SpellCheckUnlockedCells()
 Dim WorkRange As Range
 Dim FoundCells As Range
 Dim Cell As Range
 Set WorkRange = ActiveSheet.UsedRange
 
    ActiveSheet.Unprotect ("")
    For Each Cell In WorkRange
       If Cell.Locked = False Then
           If FoundCells Is Nothing Then
           Set FoundCells = Cell
           Else
           Set FoundCells = Union(FoundCells, Cell)
           End If
       End If
    Next Cell
   
    If FoundCells Is Nothing Then
           MsgBox "All cells are locked."
     Exit Sub
    Else

       Application.ScreenUpdating = True
       Application.EnableEvents = True
       
       FoundCells.Application.CommandBars("Tools").Controls("Spelling...").Execute
       
       If WorkRange Is Nothing Then
        Exit Sub
       End If
       
       MsgBox "Spell checking complete."
    End If
 End Sub

This does perform the spell check but on all cells not just unlocked cells.
I previously used the activesheet.checkspelling method which does limit the spell check to locked cells but does not highlight the cell where the error is.
Is this something we just have to live with? i.e. we can limit the spell check to unlocked cells only or we can have the cell where the error occurs highlighted but not both at the same time?
Any comments/help appreciated.

 

[Jeffrey Mahoney]

Try this

FoundCells.CheckSpelling

Instead of this

FoundCells.Application.CommandBars("Tools").Controls("Spelling...").Execute

 

[sparky2205]

Hi Jeffrey,
thanks for the response.
However, as stated above, this will only check the unlocked cells (great, that's what I want) but will not highlight the cells where the error is. So the user cannot see where the correction is being made. That's my issue.

Foundcells.CheckSpelling
only checks unlocked cells but won't highlight the cell with the error.


FoundCells.Application.CommandBars("Tools").Controls("Spelling...").Execute
highlights the cell where the error occurs but checks both locked and unlocked cells.


What I want is to be able to spell check unlocked cells only but also highlight the cells where the error occurs so that the user can see where they are making the correction.


I hope that's clear.

 

[Jeffrey Mahoney]

Excel is smart at so many things. Why can't it recognize that there are unprotected cells on a sheet and just spellcheck those? It tried a couple things and couldn't get it to work.

 

[sparky2205]

Morning Jeffrey,
yes, it would appear we are stuck with either:
highlighting the cell with the error but checking all cells
OR
checking only unlocked cells but not highlighting the cells with the error.
Pity, it sounds like it's something that could be achieved pretty easily. Maybe in the future.
Thanks very much for your efforts.

 

[sparky2205]

Hi folks,
I'm posting an update to this thread as I have been trying a few more things to get this to work. So far, unsuccessfully. But I thought it might jog someone's mind.



On a worksheet I have:
Cell Text Locked Status
A1 Small Locked
A2 Small Unlocked
A3 Smull Locked
A4 Smull Unlocked
A5 Smink Locked
A6 Smink Unlocked
A7 Tursday Locked
A8 Tursday Unlocked


My code:

Sub SpellCkUnlockedCells()
 Dim WorkRange As Range: Set WorkRange = ActiveSheet.UsedRange
 Dim FoundCells As Range
 Dim Cell As Range
    
    ActiveSheet.Unprotect ("")
    For Each Cell In WorkRange
       If Cell.Locked = False Then
           If FoundCells Is Nothing Then
           Set FoundCells = Cell
           Else
           Set FoundCells = Union(FoundCells, Cell)
           End If
       End If
    Next Cell
    
    If FoundCells Is Nothing Then
           MsgBox "All cells are locked."
           ActiveSheet.Protect Password:="", AllowFormattingCells:=True, AllowInsertingRows:=True
    Exit Sub
    Else
    
      
       Application.ScreenUpdating = True
       Application.EnableEvents = True
       
    For Each Cell In FoundCells
        If Application.CheckSpelling(Cell.Value) Then
            Cell.Select
            Cell.CheckSpelling spelllang:=6153
        End If
    Next Cell 
      
    For Each Cell In FoundCells
        Debug.Print Cell.Address
    Next Cell
       If WorkRange Is Nothing Then
        Exit Sub
       End If
       
       MsgBox "Spell checking complete."
    End If
       ActiveSheet.Protect Password:="", AllowFormattingCells:=True, AllowInsertingRows:=True
 End Sub

When I step through the code it behaves as expected in that it ignores the locked cells (A1,A3,A5,A7).
With A2 it goes through each part of the For/Next loop and moves on.
However, for the other unlocked cells (A4,A6,A8) it enters the loop but skips straight from "If" to "End If" without executing "Then". So not only is the cell not selected, the spell check is not performed.

Debug.Print for FoundCells returns; A2,A4,A6,A8 as expected.
Just wondering if this might throw any light on why this spell check doesn't work.

 

[Jaafar Tribak]

Hi @sparky2205

This is in reponse to your request in the other thread.

Here is an idea : you could take advantage of the fact that by default, the spellchecking ignores words that contain numbers... So the tacky trick is to temporarly add a number (say 1) to each locked cell that has text, temporarly reformat these cells so the added number doesn't show & goes unnoticed and finally, when the spellcheck is completed, restore back the initial locked cells text.

This trick will only work if the font of the text in the locked cells is uniform for each character in terms of font size and color.

Sub SpellCheckUnlockedCells()

     Dim WorkRange As Range, FoundCells As Range, Cell As Range
     Dim bIgnoreMixedDigits As Boolean
     Dim bSuccess As Boolean
 

      Set WorkRange = ActiveSheet.UsedRange
 
        For Each Cell In WorkRange
            If Cell.Locked = False Then
                If FoundCells Is Nothing Then
                    Set FoundCells = Cell
                Else
                    Set FoundCells = Union(FoundCells, Cell)
                End If
            End If
        Next Cell
     
   
        If FoundCells Is Nothing Then
               MsgBox "All cells are locked."
                Exit Sub
         Else
            On Error GoTo errHandler
            Application.EnableEvents = False
            ActiveSheet.Unprotect ("")
            For Each Cell In WorkRange
                If Cell.Locked Then
                    If IsEmpty(Cell) = False Then
                        If IsNumeric(Cell) = False Then
                            Cell.ID = Cell.Value & "*" & Cell.Font.Size & "*" & Cell.Font.Color
                            Cell.Value = "1" & Cell.Value
                            Cell.Characters(1, 1).Font.Color = Cell.Interior.Color
                            Cell.Characters(1, 1).Font.Size = 1
                        End If
                    End If
                End If
            Next Cell
        End If
       
        bIgnoreMixedDigits = Application.SpellingOptions.IgnoreMixedDigits
        If bIgnoreMixedDigits = False Then
            Application.SpellingOptions.IgnoreMixedDigits = True
        End If
        bSuccess = True
     
        FoundCells.Application.CommandBars("Tools").Controls("Spelling...").Execute
       
       
errHandler:
     
        For Each Cell In WorkRange
            If Cell.Locked Then
                If IsEmpty(Cell) = False Then
                    If IsNumeric(Cell) = False Then
                        Cell.Value = Split(Cell.ID, "*")(0)
                        Cell.Font.Size = Split(Cell.ID, "*")(1)
                        Cell.Font.Color = Split(Cell.ID, "*")(2)
                        Cell.ID = ""
                    End If
                End If
            End If
        Next Cell
 
        Application.EnableEvents = True
     
        If bSuccess Then
            Application.SpellingOptions.IgnoreMixedDigits = bIgnoreMixedDigits
        End If
     
'        ActiveSheet.Protect Password:="Enter Your Password Here."
     
        MsgBox "Spell checking complete."

End Sub

This trick worked for me just fine when I tested it.

There might be a simpler or better way to solve this but this is the only workaround I could think of.

Good luck.

 

[sparky2205]

Hi Jaafar,
I've gone through this and I can understand what most of it is doing. I'm a little hazy on bSuccess but I can live with that.
I tested this on a small amount of data and it worked perfectly. It did exactly what I wanted, highlighting and checking only unlocked cells.
I then transferred this to the main worksheet where it has been requested and I ran into a problem.
Everything works fine until it comes to replacing the text in the locked cells with the original values. I'm getting a "Subscript out of Range" error which usually indicates it can't find something.
When I break it down it falls over on the first attempt to re-establish the original values of the locked cells. And it appears this is because the CELL.ID value is blank.
Stepping through the code I can see the CELL.ID value being applied to the cell but somewhere along the way it appears to lose it before it is used to reassign the original value.
I tried reproducing this in a spreadsheet with just the first cell but I don't get that error.
I know it's hard to trouble shoot without the same data but does that description trigger anything with you about the possible cause of the error?

 

[Jaafar Tribak]

Can you create a workbook example that produces the problem and upload it to some file sharing site (like Box.com) ... Post a link to the uploaded file here so I can take a look.

 

[sparky2205]

Hi Jaafar,
here is the link: TinyUpload.com - best file hosting solution, with no limits, totaly free
I get the error at Cell.Value = Split(Cell.ID, "*")(0) in errHandler: