returning to the previous cell color

[Rhots]

Hi, I am using the following code (I found here), to test for unlocked cells when I am creating a sheet. (I'm really new at this) I have 2 issues. First this (below) doesn't end itself, I have to escape or pick another cell.
Second, I would like another button to return cells to the previous color after I have corrected any locked/unlocked cell errors.
Thanks,
Rick

Private Sub CommandButton2_Click()
Sheets("bf calcs").Select

Sheets("bf calcs").Unprotect ""
For Each rCell In Sheets("bf calcs").Range("A11:d41").Cells

If rCell.Locked = False Then rCell.Interior.ColorIndex = 5
Next rCell
Sheets("bf calcs").Protect ""

End Sub

 

[Rhots]

bump..help please

 

[klarowe]

Try this

Private Sub CommandButton2_Click()
    Dim rCell As Range
 
    Sheets("bf calcs").Unprotect
    For Each rCell In Sheets("bf calcs").Range("A11:D41").Cells
        If rCell.Locked = False Then
            rCell.Interior.ColorIndex = 5
        Else:
            rCell.Interior.ColorIndex = 0
        End If
    Next rCell
 
    Sheets("bf calcs").Protect ""
End Sub

If you want it to update automatically without having to continually press the command button then put this in a standard module:

Option Explicit
Sub Check_Cell_Protection()
    Dim rCell As Range
 
    Sheets("bf calcs").Unprotect
    For Each rCell In Sheets("bf calcs").Range("A11:D41").Cells
        If rCell.Locked = False Then
            rCell.Interior.ColorIndex = 5
        Else:
            rCell.Interior.ColorIndex = 0
        End If
    Next rCell
 
    Sheets("bf calcs").Protect ""
End Sub

then add this in the sheet module that you want it to work in (or sheets if there are mulitple):

Private Sub Worksheet_Change(ByVal Target As Range)
    Run "Check_Cell_Protection"
End Sub

That way anytime a change is made in that particular sheet, it will update the cell color

HTH

 

[Rhots]

Thanks for the reply, but what I am looking for is the ability to change the color back to previous. If I have cells a certain color, then the "protection check" changes a cell with that color, I want to be able to have it reset to original.
Thanks,
Rick

 

[klarowe]

how about this?

Option Explicit
Sub Check_Cell_Protection()
    Dim rCell   As Range
    Dim origColor  As Integer
 
    Sheets("bf calcs").Unprotect
    For Each rCell In Sheets("bf calcs").Range("A11:D41").Cells
    
        oColor = rCell.Interior.ColorIndex
        
        If rCell.Locked = False Then
            rCell.Interior.ColorIndex = 5
        Else:
            rCell.Interior.ColorIndex = origColor
        End If
    Next rCell
 
    Sheets("bf calcs").Protect ""
End Sub

 

[Rhots]

Not what I need yet, it does change the color for unlocked cells okay, but when I lock them ( as I would if changing incorrect cells) and run it again, it just changes it to the default "white" cell, not the original color I would have had in that cell.
Thanks for your help by the way,
Rick

 

[klarowe]

Sorry, I had a typo in that code... try this:

Option Explicit
Sub Check_Cell_Protection()
    Dim rCell   As Range
    Dim origColor  As Integer
 
    Sheets("bf calcs").Unprotect
    For Each rCell In Sheets("bf calcs").Range("A11:D41").Cells
 
        origColor = rCell.Interior.ColorIndex
 
        If rCell.Locked = False Then
            rCell.Interior.ColorIndex = 5
        Else:
            rCell.Interior.ColorIndex = origColor
        End If
    Next rCell
 
    Sheets("bf calcs").Protect ""
End Sub

Nvmd. Now this one is just "recording" the locked cell color and so is not changing. Someone else may have to chime in to get over that hurdle.