This will loop through entire WS and spell-check only unlocked cells.
Option Explicit Public Sub Spell_Checker(control As IRibbonControl) Call Spell_Checker_Sub End Sub Public Sub Spell_Checker_Sub() Dim Check As Boolean Check = IsWsProtected(ActiveSheet) If Check = True Then Dim wb As Workbook, sSheet As Worksheet, dSheet As Worksheet Set wb = ActiveWorkbook Set sSheet = wb.ActiveSheet Dim sExists As Boolean, sName As String sName = "Spell_Check_Temp" sExists = Evaluate("ISREF('" & sName & "'!A1)") If sExists = False Then With wb .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sName End With End If Set dSheet = wb.Worksheets(sName) Dim rcell As Range, rng As Range Set rng = sSheet.UsedRange For Each rcell In rng.Cells If Not IsError(rcell.Value) Then If rcell.Value <> "" Then If rcell.Locked = False Then rcell.Copy Destination:=dSheet.Range("A1") sSheet.Select rcell.Select dSheet.Range("A1").CheckSpelling dSheet.Range("A1").Copy Destination:=sSheet.Range(rcell.Address(False, False)) End If End If End If Next rcell Application.DisplayAlerts = False Worksheets(sName).Delete Application.DisplayAlerts = True sSheet.Select Else Dim sh As Worksheet For Each sh In Worksheets Sheets(sh.Name).Cells.CheckSpelling Next End If End Sub Public Function IsWsProtected(ProtectCheckWS As Worksheet) As Boolean If ProtectCheckWS.ProtectContents Then IsWsProtected = True Else IsWsProtected = False End If End Function