Modifying a Macro to properly Work

EE Pros,

This is the first of three requests associated with the same WS.

I have a simple WS that currently has a Macro that provides the ability to "double click" on a cell that produces a check mark.  I need it to only do this within a specified Range given I will be protecting the WS and also, I do not want the ability to produce check marks outside the possible selections.

I also need the helper cell reference removed.

Attached is the actual WS.

Thank you in advance,


B.
D--Data-Data-Temp-Selection-Display.xlsm
Bright01Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Change your existing code for double click event to this....

The following code will place a tick mark if the cell is in the range A8:A11 or A16:A19.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Provides check button
Dim rng As Range
Application.ScreenUpdating = False

Set rng = Union(Range("A8:A11"), Range("A16:A19"))
If Target.Column = 1 Then
   If Not Intersect(Target, rng) Is Nothing Then
    With ActiveCell
        If .Value = "P" Then
            .Value = ""
            .Offset(0, 3).ClearContents
        ElseIf .Offset(0, 1).Value <> "" Then
            .Font.Name = "Wingdings 2"
            .Value = "P"
            .Offset(0, 3).FormulaR1C1 = "1"
        End If
    End With
    Cancel = True
   End If
End If
Application.ScreenUpdating = True
End Sub

Open in new window

0
Bright01Author Commented:
Sktneer,

Thanks for the rapid response!  It works, however, isn't exactly what I asked for.

I have two range names in the WS.  I'm trying to use range names (i.e. RangeName1 and RangeName2) to identify the rows / cells that can be changed.  You're using actual Ranges.  Also, I don't think I need the Helper Cells (i.e. A16:A19) for what I'm going to do next.  So, I wouldn't need A16:A19.

Set rng = Union(Range("A8:A11"), Range("A16:A19"))

Can you see how the macro should be written with these two constraints?  Also, when I go to protect the WS, do I need to add anything in the code to unlock and relock the WS as someone double clicks the selection?

Thanks again,

B.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Try this.....

You would only be able to double click if the columns A and B are unlocked or in other words cells in RangeName1 and RangeName2 are unlocked and available for editing even if the sheet is protected.

Don't forget to input the actual password in the following code. Enclose the password with double quotes if the password is alphanumeric or a string and you won't need to enclose it with double quotes if the password is numeric.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Provides check button
Dim rng As Range
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="<Your Password Here>"
Set rng = Union(Range("RangeName1"), Range("RangeName2"))
If Target.Column = 1 Or Target.Column = 2 Then
   If Not Intersect(Target, rng) Is Nothing Then
    With ActiveCell
        If .Value = "P" Then
            .Value = ""
            .Offset(0, 3).ClearContents
        ElseIf .Offset(0, 1).Value <> "" Then
            .Font.Name = "Wingdings 2"
            .Value = "P"
            .Offset(0, 3).FormulaR1C1 = "1"
        End If
    End With
    Cancel = True
   End If
End If
ActiveSheet.Protect Password:="<Your Password Here>"
Application.ScreenUpdating = True
End Sub

Open in new window

0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

Bright01Author Commented:
Almost!  Only problem now is if I click an any other cell, even if it is protected, I get a check box in the last active, not protected (within Range) cell.  Very odd.

B.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Change With ActiveCell to With Target and see if that issue gets resolved.
0
Bright01Author Commented:
Tried it.  Still have the same problem.  Very weird.  Attached is the code.

[code/
Option Explicit
Private Sub Worksheet_Activate()
Dim cel As Range
Set cel = Target
'Set cel = ActiveCell
'  Selection.Show
Selection.Hide
cel.Select
End Sub

Private Sub Worksheet_Deactivate()
  Selection.Hide
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Provides check button
Dim rng As Range
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="jam"
Set rng = Union(Range("RangeName1"), Range("RangeName2"))
If Target.Column = 1 Or Target.Column = 2 Then
   If Not Intersect(Target, rng) Is Nothing Then
With Target
'With ActiveCell
        If .Value = "P" Then
            .Value = ""
            .Offset(0, 3).ClearContents
        ElseIf .Offset(0, 1).Value <> "" Then
            .Font.Name = "Wingdings 2"
            .Value = "P"
            .Offset(0, 3).FormulaR1C1 = "1"
        End If
    End With
    Cancel = True
   End If
End If
ActiveSheet.Protect Password:="jam"
Application.ScreenUpdating = True
End Sub

Sub button_Click()
ActiveSheet.Unprotect Password:="jam"
Const SumBtnCaps As String = "Summary, Details"
Const ShowLevels As String = "1,2"

    Dim vMatch
    With ActiveSheet.Buttons(Application.Caller)

        vMatch = Application.Match(.Caption, Split(SumBtnCaps, ","), 0)
        If Not IsError(vMatch) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=CLng(Split(ShowLevels, ",")(vMatch - 1))
            'Me.Outline.ShowLevels RowLevels:=CLng(Split(ShowLevels, ",")(vMatch))
            .Caption = Split(SumBtnCaps, ",")(vMatch Mod 2)
        End If
    End With
ActiveSheet.Protect Password:="jam"
   
    End Sub

Sub Expand_Summary()
'    ActiveSheet.Unprotect Password:="jam"
'ProtectOFF
    ActiveSheet.Outline.ShowLevels RowLevels:=2
'    ActiveSheet.Protect Password:="jam"
'    ActiveSheet.EnableSelection = xlUnlockedCells
    Range("C9").Activate
   
'    ProtectON
End Sub

/code]
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Go to the Review Tab on the Excel Ribbon --> Unprotect the sheet manually by supplying the password.

Now Protect the Sheet again, provide your password, check the box for both Select locked cells and Select unlocked cells, confirm the password again.

Now it should work fine.
In the Sheet_Activate you don't need to change ActiveCell to Target.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Bright01Author Commented:
Beautiful!  Great job Sktneer!  Appreciate your help and thanks for "hanging in there with me".   I'll be posting a follow on request shortly.  Hope you will participate..... you are gaining insight into this project quickly.

B.
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Bright! Glad I could offer some help.
It's 1:35 AM here and will be logging off now. :)
0
Bright01Author Commented:
Good night!  Where in India are you?  I often travel to Bangalore, Mumbai and Chennai.

New challenge posted.  

Thanks,


b.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.