Macro for Shading and Unshading

[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

 

[Gord Dibben]

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

 

[Per Jessen]

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

 

[Jacob Skaria]

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

 

[Tami]

Thanks Gord, Jessen, Jakob for the prompt response...it worked!
tami