Macro that is supposed to ONLY run in Named Range running everywhere

J

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
477
Office Version
  1. 365
Platform
  1. Windows
Hello, again.

I have this Worksheet_Change code that is supposed to ONLY run when the DELETE key is used on any cell in a named range. It runs anywhere, any cell, any column, any sheet. That stinks.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Intersect(Target, Range("CalendarFloorsOrderNumberColumn")) Is Nothing Then Exit Sub
    
    Application.EnableEvents = False
    
    Application.OnKey "{DELETE}", "DeleteFloorOrderNumber"
    
    Application.EnableEvents = True
    
    End If

End Sub
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
sounds like you have this in the 'thisworkbook' module. Move it to the actual sheet that you want it to run on and it will only run when the change is made on that particular sheet.
 
Upvote 0
How are you clearing the OnKey assignment? Once it's set, it will run whenever you press the delete key until you clear the OnKey.
 
Upvote 0
RoryA said:
How are you clearing the OnKey assignment? Once it's set, it will run whenever you press the delete key until you clear the OnKey.
Click to expand...

I just realized this! How do I best clear it?
 
Upvote 0
You'll probably want the worksheet activate and deactivate events (the activate event will need to check if the active cell is within the range) as well as the worksheet_selectionchange event.
 
Upvote 0
RoryA said:
You'll probably want the worksheet activate and deactivate events (the activate event will need to check if the active cell is within the range) as well as the worksheet_selectionchange event.
Click to expand...

Now you lost me. Like this?:

VBA Code: 
Private Sub Worksheet_Deactivate()
Application.OnKey "{DELETE}", ""
End Sub
 
Upvote 0
Just:

Code: 
Application.OnKey "{DELETE}"

or you’ll disable the key.
 
Upvote 0
RoryA said:
Just:

Code: 
Application.OnKey "{DELETE}"

or you’ll disable the key.
Click to expand...

OK, here's my Worksheet_SelectionChange:

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Target.Calculate
       Application.OnKey "{DELETE}"
    End Sub

Look good?
 
Upvote 0
I seem to have this working EXCEPT that it takes two presses of the DELETE key to fire the macro. Here's my code:

VBA Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
       Target.Calculate
       Application.OnKey "{DELETE}"
    End Sub
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
If Target.Range.Column = 4 Then Call ShippingInstructions
     Select Case Target.Range.Address
             Case "$B$1"
             Call OpenSettings
    End Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    On Error Resume Next

    If Not Intersect(Target, Range("ElevationColumn")) Is Nothing Then

        Application.EnableEvents = False

        Target = UCase(Target)

        Application.EnableEvents = True

    End If
    
    If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub

    On Error Resume Next

    If Not Intersect(Target, Range("SubLotColumn")) Is Nothing Then

        Application.EnableEvents = False
        
        If Trim(Target) <> "" Then
        Target = Application.Substitute(Target, "..", ".")
        End If
        
        If InStr(1, Target, "-") > 0 Then
        Target = UCase(Target)
        End If

        Application.EnableEvents = True

    End If

    On Error GoTo 0

    Dim KeyCells As Range
        
    Set KeyCells = Range("DateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
                   
    Call ChangeDate
        
    Application.EnableEvents = True
    
    End If
    
    If Not Intersect(Target, Range("DateColumn")) Is Nothing Then

    Application.EnableEvents = False

    Target = UCase(Target)

    Application.EnableEvents = True

    End If
       
    Set KeyCells = Range("SubLotColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
                   
    Call LogInsertJob
        
    Application.EnableEvents = True
    
    End If
          
    Set KeyCells = Range("CalendarFloorsInvoiceAmountColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False

    Call FloorOrderNumber
    Call AddLinkGroupAuto
    
    Application.EnableEvents = True
    
    End If
              
    Set KeyCells = Range("CalendarLooseLumberOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call LooseLumberOrderNumber
    
    Application.EnableEvents = True
    
    End If
               
    Set KeyCells = Range("CalendarHousewrapOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call HousewrapOrderNumber
    
    Application.EnableEvents = True
    
    End If
                   
    Set KeyCells = Range("CalendarRoofLoadOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call RoofLoadOrderNumber
    
    Application.EnableEvents = True
    
    End If
                       
    Set KeyCells = Range("CalendarRoofLoadShipDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call RoofLoadShipDate
    
    Application.EnableEvents = True
    
    End If
                       
    Set KeyCells = Range("CalendarBoardwalksOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call BoardwalksOrderNumber
    
    Application.EnableEvents = True
    
    End If
                              
    Set KeyCells = Range("CalendarBoardwalksShipDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call BoardwalksShipDate
    
    Application.EnableEvents = True
    
    End If
                           
    Set KeyCells = Range("CalendarPorchPostsOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call PorchPostsOrderNumber
    
    Application.EnableEvents = True
    
    End If
                               
    Set KeyCells = Range("CalendarPorchPostsShipDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call PorchPostsShipDate
    
    Application.EnableEvents = True
    
    End If
                               
    Set KeyCells = Range("CalendarFyponOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call FyponOrderNumber
    
    Application.EnableEvents = True
    
    End If
                                   
    Set KeyCells = Range("CalendarFyponOrderedDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call FyponOrderDate
    
    Application.EnableEvents = True
    
    End If
                                   
    Set KeyCells = Range("CalendarFyponReceivedDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call FyponReceivedDate
    
    Application.EnableEvents = True
    
    End If
                                   
    Set KeyCells = Range("CalendarFyponShipDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call FyponShipDate
    
    Application.EnableEvents = True
    
    End If
                               
    Set KeyCells = Range("CalendarRoofTrussesOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Call RoofTrussesOrderNumber
    
    Application.EnableEvents = True
    
    End If
    

    If Not Intersect(Target, Range("CalendarModelColumn")) Is Nothing Then
 
    Select Case Target.Value
    
        Case "<ADD NEW>"
        
            Call OpenAddNewModel

    End Select
    End If
    
    If Not Intersect(Target, Range("CalendarGarageHandlingColumn")) Is Nothing Then
 
    Select Case Target.Value
    
        Case "<ADD NEW>"
        
            Call OpenAddNewGarageHandling

    End Select
    End If
    
    Set KeyCells = Range("CalendarFloorsOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Application.OnKey "{DELETE}", "DeleteFloorOrderNumber"
    
    Application.EnableEvents = True
    
    End If
    
    Set KeyCells = Range("CalendarFloorsShipDateColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Application.OnKey "{DELETE}", "DeleteFloorShipDate"
    
    Application.EnableEvents = True
    
    End If
    
    Set KeyCells = Range("CalendarLooseLumberOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Application.OnKey "{DELETE}", "DeleteLooseLumberOrderNumber"
    
    Application.EnableEvents = True
    
    End If
    
    Set KeyCells = Range("CalendarBoardwalksOrderNumberColumn")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    
    Application.EnableEvents = False
    
    Application.OnKey "{DELETE}", "DeleteBoardwalksOrderNumber"
    
    Application.EnableEvents = True
    
    End If
  
End Sub
Private Sub Worksheet_Deactivate()
Application.OnKey "{DELETE}"
End Sub
 
Upvote 0
A Change event is only triggered after the cell has changed. I suspect you should be using the SelectionChange event to set the OnKey if the selection is in the range of interest and to clear the OnKey if it isn't.

Also, a couple of small incidental points:

Code: 
Range(Target.Address)
is pointless. Replace that with just Target

Also, there isn't a lot of point to a Select Case construction if you are only interested in one value - use If...Then instead. For example:

Code: 
    Select Case Target.Value
    
        Case "<ADD NEW>"
        
            Call OpenAddNewGarageHandling

    End Select

can just be:

Code: 
If Target.Value = "<ADD NEW>" Then OpenAddNewGarageHandling

Note also that Call is unnecessary.
 
Upvote 0
You must log in or register to reply here.

Similar threads

LuckyDPR
  • Solved
Strange behavior by Worksheet_Change event
Replies
5
Views
106
Joe4
Joe4
B
  • Solved
Getting Macros to run automatically
Replies
3
Views
205
mumps
mumps
T
  • Question
Remove duplicates
Replies
2
Views
101
tiredofit
T
J
  • Question
Excel VBA Help
2
Replies
13
Views
356
rlv01
R
KlausW
  • Solved
Run VBA one after the other
Replies
8
Views
201
Joe4
Joe4

Forum statistics

Threads
1,214,808
Messages
6,121,681
Members
449,048
Latest member
81jamesacct

Share this page

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