Sunday, November 19, 2006

Shading Unlocked Cells

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

No comments: