Protecting all cells in a sheet based on .TintAndShade

cappla011

New Member
Joined
Mar 13, 2013
Messages
32
Office Version
  1. 365
Platform
  1. Windows
Hey everyone, I'm trying to protect all cells in a sheet based on this color --

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With

Based off of this color, I am trying to protect all other cells that are not that color by using the .TintAndShade. The code I am using is --

Dim ProtectCell As Range

For Each ProtectCell In ActiveSheet.UsedRange
If ProtectCell.Interior.TintAndShade = -0.149998474074526 Then
ProtectCell.Locked = False
Else
ProtectCell.Locked = True
End If
Next ProtectCell


But it is not working. No line of the code hits the "ProtectCell.Locked = False line, it only hits the True portion everytime. Does anyone know what I am doing wrong?
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
You'll have to test against the other properties of the interior object too, not just TintAndShade.
 
Upvote 0
Hmmm so I changed the code to this --

For Each ProtectCell In ActiveSheet.UsedRange
If ProtectCell.Interior.TintAndShade = -0.149998474074526 And ProtectCell.Interior.Pattern = xlSolid And ProtectCell.Interior.PatternColorIndex = xlAutomatic And ProtectCell.Interior.ThemeColor = xlThemeColorDark1 And ProtectCell.Interior.PatternTintAndShade = 0 Then
ProtectCell.Locked = False
Else
ProtectCell.Locked = True
End If
Next ProtectCell


But it still didn't work. What am I missing?
 
Upvote 0
Wooo I figured it out on my own!

So even though I recorded a macro to figure out the .TintAndShade = -0.149998474074526, I believe that isn't really the correct number. There are probably even more decimals behind it. Because I was matching them up but it still wouldn't trigger the If statement. So I converted the .TintAndShade of the ProtectCell to a Double variable and rounded it 15 decimal places, and that is working. Here is my code --

VBA Code:
    Dim ProtectCell As Range
    Dim ShadeLock As Double
    Dim MatchingShade As Double

    MatchingShade = -0.149998474074526
    For Each ProtectCell In ActiveSheet.UsedRange
    ShadeLock = Round(ProtectCell.Interior.TintAndShade, 15)
    If ShadeLock = MatchingShade And ProtectCell.Interior.ThemeColor = xlThemeColorDark1 Then
        ProtectCell.Locked = False
    Else
        ProtectCell.Locked = True
    End If
    Next ProtectCell
 
Last edited by a moderator:
Upvote 0
Solution
Glad you figured it out. Thanks for letting us know.

For the future. when posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags in your last post for you this time. 😊
 
Upvote 0

Forum statistics

Threads
1,223,914
Messages
6,175,353
Members
452,638
Latest member
Oluwabukunmi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top