The below subs shade and unshade the unlocked cells in the active sheet. The third sub clears all the unlocked cells. When I create an application I protect the sheet and shade the cells that the users can input data into.
This is also an easy way to check what cells are unlocked.
Sub UnShade()
' Set the ColorIndex for all the unlocked cells on the
' ActiveSheet to 0.
ActiveSheet.Unprotect
Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
llastColumn = rngLast.Column
lLastRow = rngLast.Row
Set rngUsed = Range("A1", rngLast)
r = 1
c = 1
Do Until r = lLastRow + 1
Do Until c = llastColumn + 1
If Cells(r, c).Locked = False Then
Cells(r, c).Interior.ColorIndex = 0
End If
c = c + 1
Loop
c = 1
r = r + 1
Loop
ActiveSheet.Protect
End Sub
Sub Shade()
' Set the ColorIndex for all the unlocked cells on the
' ActiveSheet to 4.
ActiveSheet.Unprotect
Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
llastColumn = rngLast.Column
lLastRow = rngLast.Row
Set rngUsed = Range("A1", rngLast)
r = 1
c = 1
Do Until r = lLastRow + 1
Do Until c = llastColumn + 1
If Cells(r, c).Locked = False Then
Cells(r, c).Interior.ColorIndex = 4
End If
c = c + 1
Loop
c = 1
r = r + 1
Loop
ActiveSheet.Protect
End Sub
Sub ClearUnlockedCells()
' Clear contents of all unlocked cells in the active
' sheet.
ActiveSheet.Unprotect
Set rngLast = Range("A1").SpecialCells(xlCellTypeLastCell)
llastColumn = rngLast.Column
lLastRow = rngLast.Row
Set rngUsed = Range("A1", rngLast)
r = 1
c = 1
Do Until r = lLastRow + 1
Do Until c = llastColumn + 1
If Cells(r, c).Locked = False Then
Cells(r, c).ClearContents
End If
c = c + 1
Loop
c = 1
r = r + 1
Loop
ActiveSheet.Protect
End Sub
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment