Problem with BeforeRightClick and referencing a range

[Zanmato]

Hi everybody,

I am experiencing an extremely frustrating problem at the moment.

I am putting together a kind of appointment planner for a clinical professional to fill in. The end version will have 5 weeks (each week has its own worksheet and the layout is exactly the same, very standard - Days of the week as the headers, times (15 min intervals) down the left hand side, appointments to be put in by the user). As I'm only testing to see if I can get it to work properly, I've only done 2 sheets ("Week 1" and "Week 2") so far.

I am disabling manual editing of the sheets, and instead using a userform so that their entries are restricted. The userform, when adding an appointment at a specificied time, selects x cells below the stated time (depending on the usual duration of the type of appointment entered) as well as the cell for the stated time, and assigns a name to the range. These names are sequenced with numbers and differ depending on which Week the entry is made on and which names already exist. The format of them is like this: wk1gc1, wk1gc2, wk1pa1, wk1pa2, wk2pa1, wk2pa2, etc. Don't think that will be relevant but don't want to miss anything out.

As I am not allowing the user to manually edit the sheets (eg. add to or delete stuff from cells, add or remove formatting, etc) I thought it would be clever to make it so when the user right clicks on a cell, it will give them the option to delete the appointment (if one is there) that they are clicking on. I have used the following code to try to achieve this. I will explain the strange way it's behaving below it.

Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim answer As String
Dim NamedRange As Name
Dim NamedRes As Name

Application.ScreenUpdating = False
ActiveSheet.Unprotect "gtfo"

For Each NamedRange In ThisWorkbook.Names
    If Not Intersect(Target, Range(NamedRange)) Is Nothing Then     <------------- This row is being highlighted when the error occurs
        Set NamedRes = NamedRange
        Exit For
        Else
    End If
Next NamedRange

If NamedRes Is Nothing Then
Cancel = True
Exit Sub
End If

answer = MsgBox("Do you want to delete this appointment?", vbQuestion + vbYesNo, "Are you sure?")
If answer = vbYes Then
    Range(NamedRes).Select
    With Selection
       .ClearContents
       .ClearFormats
       .HorizontalAlignment = xlCenter
    End With
NamedRes.Delete
End If

Range("A1").Select
Cancel = True
ActiveSheet.Protect "gtfo"
Application.ScreenUpdating = True
End Sub

So, if I make an entry on Week 1, and one on Week 2, and I right click on one of the cells taken up by the entry on Week 1, the code above works as it's supposed to. It brings up the prompt, and if I press "Yes" it will delete the name from the name manager, it will clear the cells of all formatting and text. Beautiful.
If however I try to right click on the entry on Week 2 without first deleting the entry on Week 1, I get the dreaded 1004 error (Method 'Intersect' of Object '_Global' Failed) on the highlighted line above, and when I hover over the different parts of that line of code I can see that it is saying "Target = xxx" (where xxx is the text string that has been entered into the cell) whereas it should obviously be a Range/Cell Address/whatever you want to call it. I have tried playing around with this by putting stuff like Range(Target), sh.Target, Cells(Target.Row, Target.Column) etc instead of just 'Target' but it either then gives a different error or just does the same thing anyway.

If I delete the entry from Week 1, then it works fine on the entry in Week 2.

The fact that it works if there's no entry in Week 1 makes me think there's a problem with my For Each loop and that it's getting stuck somehow. Just in case I've done it stupidly and it's not clear, the loop is supposed to go through all the named ranges in the workbook and see if the target cell is in of any of them.

Further troubleshooting I thought of whilst typing this:
Tried entering the appts in reverse order which I had not done up till now (Week 2 then Week 1). Result: No change, Week 2 entry still gives 1004 err until Week 1 entry is gone.
Tried making multiple entries on Week 1 and then deleted them in random order - worked fine, no issue.

If anyone can rescue me from this hell I will be very grateful. Thank you!

 

[dmt32]

Hi,
try adding quotation marks around you named range and see if this solves your issue

For Each NamedRange In ThisWorkbook.Names
    If Not Intersect(Target, Range("NamedRange")) Is Nothing Then     '<------------- This row is being highlighted when the error occurs
        Set NamedRes = NamedRange
        Exit For
        Else
    End If
Next NamedRange

Dave

 

[Zanmato]

Hi Dave,

Thanks for taking the time to have a look at this. Unfortunately doing what you suggested still brings up the 1004 error, only with the message changing to "Method 'Range' of object '_Global' failed."

Since getting home from work I've been reading a bit more, and found this quote from another excel helpsite (a reply to someone getting the same 1004 intersect error although they are trying to something a bit different to me) - "You can't have an intersection of ranges on two sheets"
So I think maybe the problem is that the For Each is trying to determine if the Target is part of the first Named Range in the workbook, which is on another sheet, and because intersect can't work that way it's throwing up the error. I know there is a way to "skip" errors but have read several times in the past that it should be avoided. I might play around with it later tonight when I have time and see if I can make that work, even if its a temporary measure until I can figure something better out.

 

[Zanmato]

Update:

The error skipping does make it function correctly (updated code below in case anyone stumbles across this while looking for a similar solution. Note I have slightly altered one or two of the Dim'd thingies since my original post so it will look a bit different). Kept the quote marks suggested by Dave in there, didn't try it without them (why fix something that isn't broken?) but not sure if they are necessary.

I will dedicate some time when I've finished the rest of the project to trying to fix the code to avoid the need for the error skip (if nobody responds before then with a solution of course).

---------

For Each NamedRng In ThisWorkbook.Names
On Error Resume Next
    If Not Intersect(Target, Range("NamedRng")) Is Nothing Then
        Set NamedRes = NamedRng
        Exit For
        Else
    End If
On Error GoTo 0
Next NamedRng