Solved: Review Code

[U_Shrestha]

Hello all,

I have a toggle button code used to activate/deactivate the cell-highlighter. When this cell highlighter is turned off, it unprotects the sheet. Can someone please edit the code so that it doesn't affect the worksheet protection. What I want is, the cell highlighter should work no matter whether the sheet is protected or not.

This issue is also posted in its actual thread for Highlighting Rows & Columns here (http://www.vbaexpress.com/forum/showthread.php?t=17885&page=2) but it is marked as Solved, I don't know how to remove the "Solved" selection. Thanks.

Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error Goto 0
Highlighter = Not Highlighter
End Sub

[Simon Lloyd]

Just tuen on sheet protection at the end of the code!
Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error Goto 0
Highlighter = Not Highlighter
me.Protect password:="password"
End Sub

[U_Shrestha]

Hello Simon,

Thanks for the response. I tried changing the code as per your advice but it's still unprotecting as soon as I click on any cell. I have attached a sample sheet that has the exact codes in the WS module. Can you please have a look? There are 2-buttons: 1 to Activate/Deactivate cell highlighter another to protect the sheets. When I click the "Loct All Work Sheets" button, it locks the WS but as soon as I click on any cell, it goes to unprotected mode. Note: Password for WS: "password". I have following code in WS module:

Private Highlighter As Boolean

Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End Sub



Private Sub CommandButton2_Click()
'lock the WB
Dim ws As Worksheet

For Each ws In Worksheets

ws.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True

Next ws
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape

With Me
Me.Unprotect "password"

If Highlighter Then

Me.Unprotect
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0

Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End If
End With
End Sub

Private Sub FormatBlock(ByRef Block As Object)

With Block

.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 1
.Fill.Transparency = 1
.Line.Weight = 2
'.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 2 '47
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Code to insert data update date automatically in C
Dim rg As Range, rgRow As Range
On Error GoTo ExitHere
Set rg = Range("a9:b50")
If Intersect(rg, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rgRow In Intersect(Target, rg).Rows
Cells(rgRow.Row, "c") = Date
Next rgRow
ExitHere:
Application.EnableEvents = True
End Sub



I also noticed that clicking on cell doesn't unlock the sheets 2 and 3; it locks only where it has the cell-highlighter.

[Simon Lloyd]

Of course it unprotects!:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape

With Me
Me.Unprotect "password" you are telling it to here, you cannot perform the tasks you want to without unprotecting!


I also noticed that clicking on cell doesn't unlock the sheets 2 and 3; it locks only where it has the cell-highlighter.

again, you haven't specified in your code that the actions should be taken on each sheet so it occurs in the "Me" object which is the Activesheet.

[MattKlein]

it looks like

With Me
Me.Unprotect "password"
If Highlighter Then
Me.Unprotect
'...

will unprotect the sheet everytime regardless of the Highlighter status.


I also noticed that clicking on cell doesn't unlock the sheets 2 and 3; it locks only where it has the cell-highlighter.
I believe this is because you only have the code in worksheet1, thus Worksheet_SelectionChange only has scope for worksheet1. You can either copy all the code to every worksheet (bad) or create an application level event catcher in a module (not worksheet code):

'Inside a module or class
Private WithEvents App As Application
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'your code here, refrence to Sh to find out what worksheet changed
End Sub

Hope it helps!

-Matt

[U_Shrestha]

It seems to me that if following code can be editted so that the highlighter would work in both protected and unprotected mode, the it should be fine. Can you please help me on this one?

Me.Protect Dim ws As Worksheet

For Each ws In Worksheets

ws.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True

[U_Shrestha]

Hi Matt,

what code should I put in between? thanks.

'Inside a module or class
Private WithEvents App As Application
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'What Code should I put here?
End Sub

[MattKlein]

Sorry, it would be whatever code you want to have happen when any worksheet open in excel changes, so I would imagine you want to copy all the code from your current "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" into the new sub, and replace "Me" with "Sh", to refrence to the worksheet that has changed.

Also, you may want to check that the worksheet that changed is actually one you want to protect/highlight, maybe with a
if Sh.Name <> "whatever" then exit sub

-Matt

[U_Shrestha]

The following line goes red as soon as I put it in a new module.
Private WithEvents App As Application

The error message for this says :Compile error, only valid in object module.

[MattKlein]

I'm sorry, you're right....

Shamelessly stolen from http://www.cpearson.com/excel/AppEvent.aspx



OBJECT MODULE -- An Object Module is one of the following objects: a Class module, the ThisWorkbook module, a Sheet module, or the code module of a user form. You can receive events messages only with code in an objet module, since you must use the WithEvents to receive events and WithEvents is allowed only in object modules. Also, only object modules may raise custom events declared with the Public Event code and raised with the RaiseEvent statement.

[U_Shrestha]

The main problem is I don't know VB. xld had helped me by making the cell highlighter which works great in its actual thread at
http://www.vbaexpress.com/forum/showthread.php?t=17885&page=2

I am just lost here on fixing this issue about the sheet going in unprotected mode!

[MattKlein]

I think the issue with protection is in the Worksheet_SelectionChange(ByVal Target As Range) function.

What it looks like to me is the first time Me.Unprotect "password"is called in there, it will be called no matter what, thus unprotecting the sheet. I don't see the sheet being re-protected if Highlighter is false.

Stolen from the VBA help file:



Unprotect Method
Removes protection from a sheet or workbook. This method has no effect if the sheet or workbook isn't protected.
expression.Unprotect(Password)

expression Required. An expression that returns a Chart, Workbook, or Worksheet object.
Password Optional Variant. A string that denotes the case-sensitive password to use to unprotect the sheet or workbook. If the sheet or workbook isn't protected with a password, this argument is ignored. If you omit this argument for a sheet that's protected with a password, you'll be prompted for the password. If you omit this argument for a workbook that's protected with a password, the method fails.


The first call to Me.Unprotect "password" unprotects the sheet every time, then the next Me.Unprotect is useless. Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape
With Me
If Highlighter Then
Me.Unprotect "password"
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error Goto 0
Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End If
End With
End Sub

[Simon Lloyd]

with

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
every time you change a selection the code runs, in this you have the unprotect, so, when you change cells on the worksheet that the code is in it will unprotect the sheet. You could use something like:

If Highlighter =True then
Me.Unprotect
Else
Me.Protect
Exit sub
End If

[U_Shrestha]

Hi Matt,

that solves half of the problem. now, when i click on any cell in protected mode, the worksheet doesn't go to protected mode, but now the next problem is, while a the workbook is in unprotected mode, turning on the cell-highlighter takes the worksheet to protected mode. Actually, I am looking to have the cell-highlighter work in both the protected and unprotection mode, and selecting either of the option should not interfere with the worksheet protection mode. thanks.

[U_Shrestha]

Hi Simon,

I editted the code like you said, but now I am having exact opposite effect; the sheet in question goes to protection mode as soon as any cell is selected in the worksheet! I have this code in my WS module.
Private Highlighter As Boolean

Private Sub CommandButton1_Click()
Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End Sub



Private Sub CommandButton2_Click()
'lock the WB
Dim ws As Worksheet

For Each ws In Worksheets

ws.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True

Next ws
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape
With Me
If Highlighter = True Then
'If Highlighter =True Then
Me.Unprotect "password"
Else
Me.Protect "password"
Exit Sub
End If

On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True

End With
End Sub

Private Sub FormatBlock(ByRef Block As Object)

With Block

.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.SchemeColor = 1
.Fill.Transparency = 1
.Line.Weight = 2
'.Line.DashStyle = msoLineSquareDot
.Line.Style = msoLineSingle
.Line.Transparency = 0#
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 2 '47
.Line.BackColor.RGB = RGB(255, 255, 255)
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Code to insert data update date automatically in C
Dim rg As Range, rgRow As Range
On Error GoTo ExitHere
Set rg = Range("a9:b50")
If Intersect(rg, Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rgRow In Intersect(Target, rg).Rows
Cells(rgRow.Row, "c") = Date
Next rgRow
ExitHere:
Application.EnableEvents = True
End Sub

[Simon Lloyd]

When constructing your Protect code did you allow both locked and unlocked cells to be selected?, if you didn't then you cannot select a locked cell while protected!

[MattKlein]

Testing and remembering the .ProtectContents should work

This should work for you:

Private Sub CommandButton1_Click()
Dim bProtected as Boolean
bProtected = Me.ProtectContents

Me.Unprotect "password"
On Error Resume Next
Me.Shapes("_Block_Vertical").Delete
Me.Shapes("_Block_Horizontal").Delete
On Error Goto 0
Highlighter = Not Highlighter
if bProtected then
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
end if
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Dim mpBlock As Shape
Dim bProtected as Boolean
bProtected = Me.ProtectContents

With Me

If Highlighter Then

Me.Unprotect "password"
On Error Resume Next
.Shapes("_Block_Vertical").Delete
.Shapes("_Block_Horizontal").Delete
On Error Goto 0

Set rng = .Cells(1, Target.Column)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.ColumnWidth * 5.7, 5000)
mpBlock.Name = "_Block_Vertical"
Call FormatBlock(Block:=mpBlock)
Set rng = .Cells(Target.Row, 1)
Set mpBlock = .Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, 5000, rng.RowHeight)
mpBlock.Name = "_Block_Horizontal"
Call FormatBlock(Block:=mpBlock)

if bProtected then
Me.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
end if

End If
End With
End Sub

[U_Shrestha]

hello matt,

your code really worked :dance:

thank you both :)

[U_Shrestha]

I am sorry to bother again. Is there a particular reason why I cannot Active/Deactivate the cell highlighter from a command button embedded in a userform? I have attached the sample sheet. I would really appreaciate your help. Thanks.

[MattKlein]

My first guess is the "Me." is refering to the userform now and not the worksheet. Try replacing "Me." with "ActiveSheet."

If that doesn't work, let me know and I'll look into the code.

[U_Shrestha]

Behind the command button, i placed following code. It didn't work.
Dim bProtected As Boolean
bProtected = ActiveSheet.ProtectContents

ActiveSheet.Unprotect "password"
On Error Resume Next
ActiveSheet.Shapes("_Block_Vertical").Delete
ActiveSheet.Shapes("_Block_Horizontal").Delete
On Error GoTo 0
Highlighter = Not Highlighter
If bProtected Then
ActiveSheet.Protect "password", AllowFiltering:=True, UserinterfaceOnly:=True, _
Contents:=True, DrawingObjects:=True
End If
Do I need to add anything else? Thanks.