EnableEvents not working as expected on cell shifting VBA

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
This is a two pronged question.

Firstly, when someone tabs and it shifts focus to either G15 or G16, I want them to be moved to another cell.

The second part is that I wonder how this can be shortened so that G15 goes to C16 and G16 goes to C20.

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
    Const sCELL_TO_SKIP As String = "G15:G16" 'Stop user selecting G16
    Const sJUMP_TO_CELL As String = "C16" 'Move user to C16
    Dim rCellToSkip     As Range
    Set rCellToSkip = Me.Range(sCELL_TO_SKIP)
    If Not Intersect(Target, rCellToSkip) Is Nothing Then
Application.EnableEvents = True
        Me.Range(sJUMP_TO_CELL).Activate
    End If
End Sub

Thank you.

EDIT:
Missed out some information:
Firstly, when someone tabs and it shifts focus to either G15 or G16, I want them to be moved to another cell without the user seeing focus first go to G15 or G16. That should be invisible and when tabbing, it should go appear to go to C16 or G16 immediately.
 
Last edited by a moderator:

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
Questions still relevant but I realise I should have said

VBA Code:
Application.ScreenUpdating = False
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,904
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hi,
see if this update to your code does what you want

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim CellsToSkip     As Range, CellsToJumpTo As Range
    Dim JumpTo          As String
    
    Const sCELL_TO_SKIP As String = "G15,G16" 'Stop user selecting G15,G16
    Const sJUMP_TO_CELL As String = "C16,C20" 'Move user to C15, C16
    
    On Error GoTo exitsub
    Set CellsToSkip = Me.Range(sCELL_TO_SKIP)
    Set CellsToJumpTo = Me.Range(sJUMP_TO_CELL)
    
    If Not Intersect(Target, CellsToSkip) Is Nothing Then
    
         With Application
            .EnableEvents = False: .ScreenUpdating = False
         End With
         
        JumpTo = IIf(Not Intersect(Target, CellsToSkip.Areas(1)) Is Nothing, 1, 2)
        CellsToJumpTo.Areas(JumpTo).Activate
       
    End If
   
exitsub:
    With Application
        .EnableEvents = True: .ScreenUpdating = True
    End With
End Sub

Dave
 
Last edited:

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
Thank you Dave, that's very interesting code. It works to keep the tabbing order correct.

When tabbing reaches the cells to be avoided, it's still visible that it's switching from those cells to the next safe ones though. Is it not possible?
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,904
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
When tabbing reaches the cells to be avoided, it's still visible that it's switching from those cells to the next safe ones though. Is it not possible?

Your code moves selection from cell to be avoided to required cell so action will be visible - Only way I can think to avoid this is with a custom tabbing solution for your worksheet that defines all the allowed cells & their tab order.

Dave
 

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
VBA Code:
Option Explicit

Private Sub Worksheet_Activate()
    With Worksheets("Instalments")
Application.EnableEvents = False
    Range("A1").Select
Application.EnableEvents = True
        .Unprotect
        .Range("C10:F10").ClearContents
        .Columns("F").Hidden = True
        .Range("C20").Value = "'Discount?"
        .Protect
        .Range("C4").Select
    End With
    With ActiveWindow
        .DisplayFormulas = False
        .DisplayHeadings = False
        .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
    End With
    With Application
        .DisplayFullScreen = True
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
        .CommandBars("Full Screen").Visible = True
        .CommandBars("Worksheet Menu Bar").Enabled = False
        .CommandBars("Standard").Visible = False
        .CommandBars("Formatting").Visible = False
    End With
Application.OnKey "{TAB}", "InstalmentTabbing.ProcessTab"
Application.OnKey "+{TAB}", "InstalmentTabbing.ProcessBkTab"
'Cells included in array
InstalmentTabbing.arr = Array("$C$4", "$D$4", "$C$10", "$D$10", "$E$10", "$F$10", "$C$16", "$D$16", "$E$16", "$C$20")
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'Check choices made and show/hide rows/columns accordingly
    Sheets("Instalments").Unprotect
        Select Case Target.Address(0, 0)
            'Case "C16:E16" 'Results
            '    If TargetValue = (Len(Target.Value) > 0) Then
            '        Range("17:18").EntireRow.Hidden = False
            '        Range("17:18").EntireRow.Hidden = True
            '    End If
            Case "G16" 'Tick box
                ActiveSheet.Shapes("CheckBox6").Visible = (Len(Target.Value) > 0)
            Case "C10" 'Temporary debit calculator
                If Target.Value = "No Payments" Then
                    Range("F:F").EntireColumn.Hidden = True
                ElseIf Target.Value = "Credit on Account" Then
                    Range("F:F").EntireColumn.Hidden = False
                ElseIf Target.Value = "Debit on Account" Then
                    Range("F:F").EntireColumn.Hidden = False
                End If
            Case "C20" 'Discount calculator
                If Target.Value = "No Discount" Then
                    Range("21:34").EntireRow.Hidden = True
                    Range("C20").Select
                ElseIf Target.Value = "25% Discount" Then
                    Range("21:24").EntireRow.Hidden = False
                    Range("25:34").EntireRow.Hidden = True
                ElseIf Target.Value = "50% Discount" Then
                    Range("26:29").EntireRow.Hidden = False
                    Range("21:25").EntireRow.Hidden = True
                    Range("30:34").EntireRow.Hidden = True
                ElseIf Target.Value = "50% Discount & 25% Discount" Then
                    Range("31:34").EntireRow.Hidden = False
                    Range("21:30").EntireRow.Hidden = True
                End If
    Sheets("Instalments").Protect
                Range("C20").Select
        End Select
End Sub
'If tickbox cell is selected, prevent modification and move to next usable cell
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim thisAddress As String 'Tabbing
    thisAddress = Split(Target.Address, ":")(0) 'Tabbing
    InstalmentTabbing.strAddress = Target.Address 'Tabbing

'    Dim CellsToSkip     As Range, CellsToJumpTo As Range
'    Dim JumpTo          As String
   
'    Const sCELL_TO_SKIP As String = "G15,G16" 'Stop user selecting G15,G16
'    Const sJUMP_TO_CELL As String = "C16,C20" 'Move user to C15, C16
   
'    On Error GoTo exitsub
'    Set CellsToSkip = Me.Range(sCELL_TO_SKIP)
'    Set CellsToJumpTo = Me.Range(sJUMP_TO_CELL)
   
'    If Not Intersect(Target, CellsToSkip) Is Nothing Then
   
'         With Application
'            .EnableEvents = False: .ScreenUpdating = False
'         End With
        
'        JumpTo = IIf(Not Intersect(Target, CellsToSkip.Areas(1)) Is Nothing, 1, 2)
'        CellsToJumpTo.Areas(JumpTo).Activate
      
'    End If
  
'exitsub:
'    With Application
'        .EnableEvents = True: .ScreenUpdating = True
'    End With
End Sub

Sub Worksheet_Deactivate()

End Sub
'  MsgBox "Disabled Clipboard." 'confirms this routine is running
    Application.OnKey "{TAB}"
    Application.OnKey "+{TAB}"
End Sub
 
Last edited:

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
InstalmentTabbing
VBA Code:
Option Explicit

Public arr As Variant
Public strAddress As String

Public Sub ProcessTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
    For i = 0 To UBound(arr)
        If arr(i) = Split(strAddress, ":")(0) Then
            If i = UBound(arr) Then
                i = 0
            Else
                i = i + 1
            End If
            Exit For
        End If
    Next
    ActiveSheet.Range(arr(i)).Select
Else
    strAddress = arr(0)
End If
End Sub

Public Sub ProcessBkTab()
Dim i As Integer
If Len(strAddress) <> 0 Then
    For i = 0 To UBound(arr)
        If arr(i) = Split(strAddress, ":")(0) Then
            If i = 0 Then
                i = UBound(arr)
            Else
                i = i - 1
            End If
            Exit For
        End If
    Next
    ActiveSheet.Range(arr(i)).Select
Else
    strAddress = arr(0)
End If
End Sub

****, in my haste to edit my post before the 10 minute restriction stopped me, I lost my post description.


Essentially, I said I wondered whether I would be able to implement a simpler solution. I need to protect G15 and G16 from being selected or edited. G15 contains a TRUE/FALSE statement. G16 contains the tickbox controlling TRUE/FALSE. Ideally I want to lock both cells but enable the user to use the tickbox and the tickbox to control TRUE/FALSE.

I wondered whether

VBA Code:
Protect UserInterFaceOnly:=True

could help in this situation?
 

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
I'm confused though because I already have this code implemented in ThisWorkbook:

VBA Code:
Option Explicit

Private Sub Workbook_Open()
    ' Bug in Excel:
    ' The Worksheet_Activate event does not fire for the sheet that is active
    ' when the workbook is opened, so call it explicitely. Make sure that
    ' Worksheet_Activate() is declared as Public.
    ' Ignore ActiveSheets without (Public) Worksheet_Activate()
    On Error Resume Next
    Call ActiveSheet.Worksheet_Activate
    On Error GoTo 0
'Initialise the array
'    Call ClipOff
'Make selection on clipboard
    With Sheet10
'Insert text into Clipboard
    .Unprotect
    .Shapes("Status").TextFrame.Characters.Text = "Input Mode"
    .Protect
    End With
 Application.EnableEvents = False
' Add words to cells in specified worksheets and set permissions
    Dim wks As Worksheet
    For Each wks In Worksheets
        If wks.Name = "Property Numbering" Then
            wks.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            wks.Range("C14,C8").ClearContents
            wks.Range("B2").Value = "'Property Reference Guide (Click Arrow to Start)"
            wks.Range("C14,C8").Value = "'Choose"
        ElseIf wks.Name = "VO Areas" Then
            wks.Protect UserInterFaceOnly:=True, AllowSorting:=True, AllowFiltering:=True
            wks.Range("C4").ClearContents
            wks.Range("C4").Value = "'Choose"
        Else
            wks.Protect UserInterFaceOnly:=True
        End If
    Next
Application.EnableEvents = True
End Sub

As it's not a named worksheet, it's already set this way isn't it? By

VBA Code:
        Else
            wks.Protect UserInterFaceOnly:=True

Am I right?

If so, that's not the solution.
 

TheJay

Active Member
Joined
Nov 12, 2014
Messages
354
Office Version
  1. 2019
Platform
  1. Windows
The code I have included above deals with forward and back tabbing within the sheet. I have another sheet that requires a different order of tabbing and backtabbing, so whilst that link is interesting, it's not needed in this instance.

It seems a bit overkill in this instance. Tabbing on this particular sheet would be fine if I could lock the cells I mentioned yet still allow the user to use the tickbox without inputting/pasting anything into the cell G16 and if the action of ticking or unticking the box would be permitted by Excel to change between TRUE/FALSE in G15.
 

Forum statistics

Threads
1,186,062
Messages
5,955,622
Members
438,207
Latest member
Excel Pro Tips Guy

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
Top