EnableEvents not working as expected on cell shifting VBA

[TheJay]

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.

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.

 

[TheJay]

Questions still relevant but I realise I should have said

Application.ScreenUpdating = False

 

[dmt32]

Hi,
see if this update to your code does what you want

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

 

[TheJay]

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]

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]

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

 

[TheJay]

InstalmentTabbing

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

Protect UserInterFaceOnly:=True

could help in this situation?

 

[TheJay]

I'm confused though because I already have this code implemented in ThisWorkbook:

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

        Else
            wks.Protect UserInterFaceOnly:=True

Am I right?

If so, that's not the solution.

 

[dmt32]

If you are trying to setup a specific tabbing order in your worksheet then have a look at this thread: VBA Code - Effecting entire Workbook not just a Worksheet

use codes in #posts 3 & 6 & see if this will do what you want

Dave

 

[TheJay]

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.