Modifying a Macro to properly Work

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

Select allOpen in new window

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.

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

Select allOpen in new window

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.

Change With ActiveCell to With Target and see if that issue gets resolved.

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]

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.

You're welcome. Bright! Glad I could offer some help.
It's 1:35 AM here and will be logging off now. :)

Good night!  Where in India are you?  I often travel to Bangalore, Mumbai and Chennai.

New challenge posted.  

Thanks,


b.