Macro for Shading and Unshading

  • Thread starter Thread starter Tami
  • Start date Start date
T

Tami

I have the following 2 macros as buttons on a custom toobar to Shade or
Unshade cells.

Sub Shade_Cell()
'
' Shade_Cell Macro
'
ActiveSheet.unprotect Password:="paspas"
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
ActiveSheet.Protect Password:="paspas", DrawingObjects:=True,
Contents:=True, Scenarios:=True, AllowInsertingRows:=False,
AllowDeletingRows:=False
End With
End Sub


Sub unshade()
'
' unshade Macro

ActiveSheet.unprotect Password:="paspas"
Selection.Interior.ColorIndex = xlNone
ActiveSheet.Protect Password:="paspas", DrawingObjects:=True,
Contents:=True, Scenarios:=True, AllowInsertingRows:=False,
AllowDeletingRows:=False
End Sub

Is there anyway to merge these two macros to one button on my custom
toolbar. So if the range highlighted is already shaded this color (35) then
unshade....if it has no shade then change it to 35.
thanks in advance for any help.
tami
 
Sub Toggle_Shade_Cell()

ActiveSheet.Unprotect Password:="paspas"
With Selection.Interior
If .ColorIndex = 35 Then
.ColorIndex = xlNone
Else
.ColorIndex = 35
End If
End With
ActiveSheet.Protect Password:="paspas", DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowInsertingRows:=False, _
AllowDeletingRows:=False

End Sub

The pattern = xlsolid is default so not really needed.


Gord Dibben MS Excel MVP
 
Hi

It can be done like this:

Sub Shade_Unshade()
'Shade / unshade macro
ActiveSheet.Unprotect Password:="paspas"
If Selection.Interior.ColorIndex = xlNone Then
With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
Else
Selection.Interior.ColorIndex = xlNone
End If
ActiveSheet.Protect Password:="paspas", DrawingObjects:=True,
Contents:=True, _
Scenarios:=True, AllowInsertingRows:=False, AllowDeletingRows:=False
End Sub

Regards,
Per
 
Hi Tami

Try the below

Sub ShadeUnshade_Cell()
ActiveSheet.Unprotect Password:="paspas"
With Selection.Interior
..ColorIndex = IIf(.ColorIndex = xlNone, 35, xlNone)
If .ColorIndex = 35 Then .Pattern = xlSolid
ActiveSheet.Protect Password:="paspas", DrawingObjects:=True, _
Contents:=True, Scenarios:=True, AllowInsertingRows:=False, _
AllowDeletingRows:=False
End With
End Sub

If this post helps click Yes
 
Back
Top