VBA Code for Tab order

[kevindow]

How can I create a custom tab order (for example A1-B6-D4 etc...) that is not contingent on a protected worksheet. I have found the following code on-line but I am having some issues with the code. For one it only advances via tab if I enter a change into a given cell. Another problem is if I enter data inside a cell that is not listed in the code it gives an error message. Any suggestions.

Private Sub Worksheet_Change(ByVal Target As Range) Dim aTabOrd As Variant Dim i As Long 'Set the tab order of input cells aTabOrd = Array("A5", "B5", "C5", "A10", "B10", "C10") 'Loop through the array of cell address For i = LBound(aTabOrd) To UBound(aTabOrd) 'If the cell that's changed is in the array IfaTabOrd(i) = Target.Address(0, 0) Then 'If the cell that's changed is the last in the array If i =UBound(aTabOrd) Then 'Select first cell in the array Me.Range(aTabOrd(LBound(aTabOrd))).Select Else'Select next cell in the array Me.Range(aTabOrd(i + 1)).Select End If End If Next i End Sub

 

[Jerry Sullivan]

Hi and Welcome to the Board,

You would probably need to use the Worksheet_SelectionChange event instead of the Worksheet_Change event.

That's more difficult because instead of the code using the Target (the changed cell) to determine what cell to select next, the code would need to compare the Target (currently selected cell(s)) to the previously selected cell(s).

This could get very complicated if you don't place some reasonable limits on what scenarios the code needs to handle, such as:
1. No worksheet protection that would affect the tabbing order

2. Define Tabbing as a single cell being selected that is adjacent and to the right of the previous selection (also a single cell) on that sheet.
Some examples:
2.1 Cell A1 is selected and the user hits the Tab key and then B1 will be selected. The code will evaluate that a tab has occurred and change the selection to the cell that follows A1 in your custom Tab order.

2.2 Cell A1 is selected and the user hits the Right-Arrow key. The code will evaluate that a tab has occurred and behave like 2.1

2.3 Cell A1 is selected and the user clicks to select B1. The code will evaluate that a tab has occurred and behave like 2.1

2.4 Cells A1:A10 are selected and the user clicks to select B1. The code will evaluate that a tab has not occurred and do nothing.

2.5 Cells A1:B10 are selected and the hits the Tab key causing no change in Selection, but the ActiveCell changes to B1.The code will not trigger, doing nothing.

3 The previously selected Cell needs to be a cell within the custom Tab Order. If it's not the code would do nothing.

It's an interesting puzzle and I'd be glad to help suggest some code if you want to pursue this approach.

 

[dmt32]

Hi,</SPAN>
Code you have is well published but does as you have discovered, have some limitations. I have suggested to other OPs on this board using it another way with the Onkey method rather than the sheets Selection change event. For one OP at least, feedback was positive so this approach may be of some help to you.</SPAN>

To take into account some of the likely problems that you may encounter by using an unprotected worksheet which has already been extensively highlighted by another contributor, I have modified my suggested approach to using this code.</SPAN>

Place the following code in the ThisWorkbook Module:</SPAN>

You will need to change the sheet name in RED</SPAN> as required.</SPAN>

</SPAN>
Private Sub Workbook_Open()</SPAN>
    Dim ws As Worksheet</SPAN>
    Set ws = Worksheets("Sheet1</SPAN>")</SPAN>
    If ActiveSheet.Name <> ws.Name Then</SPAN>
        Application.EnableEvents = False</SPAN>
        ws.Activate</SPAN>
        Application.EnableEvents = True</SPAN>
    End If</SPAN>
End Sub</SPAN>
 
Private Sub Workbook_WindowActivate(ByVal Wn As Window)</SPAN>
SetOnkey True</SPAN>
End Sub</SPAN>
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)</SPAN>
SetOnkey False</SPAN>
End Sub</SPAN>

</SPAN>


Place this code in the worksheets code page</SPAN>

</SPAN>
Private Sub Worksheet_Activate()</SPAN>
    SetOnkey True</SPAN>
End Sub</SPAN>
 
Private Sub Worksheet_Deactivate()</SPAN>
    SetOnkey False</SPAN>
End Sub</SPAN>
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)</SPAN>
TabRange 2, CStr(Target.Address(0, 0))</SPAN>
End Sub</SPAN>

</SPAN>

Place this code in a standard module:</SPAN>

</SPAN>
Sub SetOnkey(ByVal state As Boolean)</SPAN>
    If state Then</SPAN>
        TabRange 1</SPAN>
        With Application</SPAN>
            .OnKey "{TAB}", "'TabRange 0'"</SPAN>
            .OnKey "~", "'TabRange 0'"</SPAN>
            .OnKey "{RIGHT}", "do_nothing"</SPAN>
            .OnKey "{LEFT}", "do_nothing"</SPAN>
            .OnKey "{DOWN}", "do_nothing"</SPAN>
            .OnKey "{UP}", "do_nothing"</SPAN>
        End With</SPAN>
    Else</SPAN>
    'reset keys</SPAN>
        With Application</SPAN>
            .OnKey "{TAB}"</SPAN>
            .OnKey "~"</SPAN>
            .OnKey "{RIGHT}"</SPAN>
            .OnKey "{LEFT}"</SPAN>
            .OnKey "{DOWN}"</SPAN>
            .OnKey "{UP}"</SPAN>
        End With</SPAN>
    End If</SPAN>
End Sub</SPAN>
 
Sub do_nothing()</SPAN>
'nothing to do</SPAN>
End Sub</SPAN>
 
Sub TabRange(ByVal startcell As Integer, Optional cell As String)</SPAN>
    Dim sTarget As Range</SPAN>
    Dim sTabOrder As Variant</SPAN>
    Dim i As Long</SPAN>
    Dim m As Variant</SPAN>
    Dim sh As Worksheet</SPAN>
 
    Set sh = ActiveSheet</SPAN>
    Set sTarget = ActiveCell</SPAN>
 
    Application.EnableEvents = False</SPAN>
 
    'Set the tab order of input cells - change ranges as required</SPAN>
    sTabOrder = Array("D8", "F8", "H8", "L6", "L8", "D12")</SPAN></SPAN>
 
    On Error Resume Next</SPAN>
    'if selection made other than by</SPAN>
    'Tab or Enter key check selection is</SPAN>
    'in required range</SPAN>
    If startcell = 2 Then</SPAN>
        m = Application.Match(cell, sTabOrder, False)</SPAN>
        If IsError(m) Then</SPAN>
        startcell = 1</SPAN>
        Else</SPAN>
        'in range</SPAN>
        GoTo ExitSub</SPAN>
        End If</SPAN>
        On Error GoTo 0</SPAN>
    End If</SPAN>
 
    'ensure 1st range is selected when sheet activated</SPAN>
    If startcell = 1 Then sh.Range(sTabOrder(LBound(sTabOrder))).Select: GoTo ExitSub</SPAN>
 
‘published taborder code</SPAN>
    'Loop through the array of cell address</SPAN>
    For i = LBound(sTabOrder) To UBound(sTabOrder)</SPAN>
        'cell in array</SPAN>
        If sTabOrder(i) = sTarget.Address(0, 0) Then</SPAN>
            'cell last in array</SPAN>
            If i = UBound(sTabOrder) Then</SPAN>
                'Select first cell in array</SPAN>
                sh.Range(sTabOrder(LBound(sTabOrder))).Select</SPAN>
            Else</SPAN>
                'Select next cell in array</SPAN>
                sh.Range(sTabOrder(i + 1)).Select</SPAN>
            End If</SPAN>
        End If</SPAN>
    Next i</SPAN>
ExitSub:</SPAN>
    Application.EnableEvents = True</SPAN>
End Sub</SPAN>

</SPAN>

You will need to define your tab range in the array above shown in RED</SPAN> but although this approach is more involved than the published tab code( which itself I have left unchanged), and although not fully tested it should hopefully, do what you want. – Unless someone here can think of a cleaner solution.</SPAN>

Hope helpful</SPAN>

Dave.</SPAN>

 

[kevindow]

Thank you for your answers. I am not a programer (music teacher creating a grading program), so it is going to take a little time for me to work with your solutions in my program. I will insert this weekend and see how it goes. Thanks again

 

[Jerry Sullivan]

Hi Dave,

Thanks for the sharing that code. I won't have a chance to look that over in detail until tonight, but I agree that using .OnKey is a better approach than Worksheet_SelectionChange.

If I see any tweaks that could help @kevindow adapt the code for his purpose, I'll post those.

 

[dmt32]

Hi Jerry,
most welcome, we are all here to help each other. Since posting thought to include the left & right arrows keys & made changes below. If you can add some polish to what I have done for OP or anyone else that may be interested, then please feel free to.

Dave

Sub SetOnkey(ByVal state As Boolean)
    If state Then
        TabRange 1
        With Application
            .OnKey "{TAB}", "'TabRange 0'"
            .OnKey "~", "'TabRange 0'"
            .OnKey "{RIGHT}", "'TabRange 0'"
            .OnKey "{LEFT}", "'TabRange 3'"
            .OnKey "{DOWN}", "do_nothing"
            .OnKey "{UP}", "do_nothing"
        End With
    Else
    'reset keys
        With Application
            .OnKey "{TAB}"
            .OnKey "~"
            .OnKey "{RIGHT}"
            .OnKey "{LEFT}"
            .OnKey "{DOWN}"
            .OnKey "{UP}"
        End With
    End If
End Sub

Sub do_nothing()
'nothing to do
End Sub


Sub TabRange(ByVal startcell As Integer, Optional cell As String)
    Dim sTarget As Range
    Dim sTabOrder As Variant
    Dim i As Long
    Dim m As Variant
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Set sTarget = ActiveCell
    Application.EnableEvents = False
    'Set the tab order of input cells - change ranges as required
    sTabOrder = Array("D8", "F8", "H8", "L6", "L8", "D12")
    On Error Resume Next
    'if selection made other than by
    'Tab or Enter key check selection is
    'in required range
    If startcell = 2 Then
        m = Application.Match(cell, sTabOrder, False)
        If IsError(m) Then
            startcell = 1
        Else
            'in range
            GoTo ExitSub
        End If
        On Error GoTo 0
    End If
    
    'ensure 1st range is selected when sheet activated
    If startcell = 1 Then sh.Range(sTabOrder(LBound(sTabOrder))).Select: GoTo ExitSub
   
 'Loop through the array of cell address
 'modified published code
    For i = LBound(sTabOrder) To UBound(sTabOrder)
        'cell in array
        If sTabOrder(i) = sTarget.Address(0, 0) Then
            'cell last in array
            If i = UBound(sTabOrder) Then
                If startcell = 0 Then
                    'Select first cell in array
                    sh.Range(sTabOrder(LBound(sTabOrder))).Select
                Else
                    'Select previous cell in array
                    'using left arrow key
                    sh.Range(sTabOrder(i - 1)).Select
                End If
            
            ElseIf startcell = 0 Then
                'Select next cell in array
                'using Tab,Enter or Right Arrow keys
                sh.Range(sTabOrder(i + 1)).Select
            Else
                'Select previous cell in array
                'using left arrow key
                sh.Range(sTabOrder(i - 1)).Select
            End If
        End If
    Next i
ExitSub:
    Application.EnableEvents = True
End Sub

 

[kevindow]

Ok I ran the examples listed above and did a quick test of the document. I receive the following error and I think it is probably how I set the parenthesize with the title of my sheets.
Set ws = Worksheets("Sheet1 (Seating Chart Q1)")

On the other hand the new tab order seems to work. Most of the cells are linked to other cells in other worksheets within the document, I am hoping that those are not effected. I also noticed that once the code is entered that I can't select any cell that is outside of the array even when the sheet is un protected. I think this is fine, but I will have to make all changes to the document before entering code.

I paid a programer $125.00 Hr to help with this code and a couple other questions and he wasn't able to help at all. Already your answers have taken me a good deal closer to helping with my document.

Just in case you are not tired of my questions, other questions I asked of the programer was: 1. How can I create a VBA code to link to a drop down selection button in which will only print specific sheets within the document? 2. Is there a possibility of linking 2 or 3 cells together so I can enter data in any of the cells which change all the cells simultaneously. For example: I can create an = link which If I enter data into A1 will simultaneously change the data in B3 and or D5. But is there a way that I can also enter data into B3 or D5 and it will change A1? (I always get a circular reference error).

Thanks for your help. Perhaps I could hire you to help. One thing the programer and his business did say that was interesting is that since there is not a program like mine out there (music teaching seating chart grading program) that it would probably be marketable as an App.

 

[dmt32]

Ok I ran the examples listed above and did a quick test of the document. I receive the following error and I think it is probably how I set the parenthesize with the title of my sheets.

if your worksheet name is Seating Chart Q1

You need to change this:

Set ws = Worksheets("Sheet1 (Seating Chart Q1)")

to this:

Set ws = Worksheets("Seating Chart Q1")

I also noticed that once the code is entered that I can't select any cell that is outside of the array even when the sheet is un protected.

This feature was included to meet with your original request. If you need to work on your table in an "Admin" capacity then a simple workaround is to just add Exit Sub line at beginning of TabRange procedure:

Sub TabRange(ByVal startcell As Integer, Optional cell As String)
Exit Sub '<<< remove when not required

Just don't forget to remove it when done.

I paid a programer $125.00 Hr to help with this code and a couple other questions and he wasn't able to help at all.

I'd ask for a rebate - but to answer your other question about hiring, I am retired & what spare time I have, I contribute to this board in its aim of providing a free help & advice to others where I can.

Your other issues - others here can probably assist you with, just follow forum rules & post links to sample workbook with clear explanation of what you need help with.

Dave

 

[Jerry Sullivan]

Dave and @kevindow,

I've modified Dave's code in way that seems cleaner to me.

In a copy of your workbook, replace the previous code with these parts in each module (I've eliminated some event procedures so don't leave the previous versions in this file).

In the ThisWorkBook Module...

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = "Sheet1" Then SetOnkey True
End Sub
 

Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey False
End Sub

In the Sheet Module "Seating Chart Q1"...

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = "Sheet1" Then SetOnkey True
End Sub

 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey False
End Sub

In a Standard Code Module...

Sub SetOnkey(ByVal state As Boolean)
    If state Then
        With Application
            .OnKey "{TAB}", "'TabRange xlNext'"
            .OnKey "~", "'TabRange xlNext'"
            .OnKey "{RIGHT}", "'TabRange xlNext'"
            .OnKey "{LEFT}", "'TabRange xlPrevious'"
            .OnKey "{DOWN}", "do_nothing"
            .OnKey "{UP}", "do_nothing"
        End With
    Else
    'reset keys
        With Application
            .OnKey "{TAB}"
            .OnKey "~"
            .OnKey "{RIGHT}"
            .OnKey "{LEFT}"
            .OnKey "{DOWN}"
            .OnKey "{UP}"
        End With
    End If
End Sub


Sub do_nothing()
'nothing to do
End Sub


Sub TabRange(Optional iDirection As Integer = xlNext)

Dim vTabOrder As Variant, m As Variant
Dim lItems As Long, iAdjust As Long

'--set the tab order of input cells - change ranges as required
vTabOrder = Array("D8", "F8", "H8", "L6", "L8", "D12")
lItems = UBound(vTabOrder) - LBound(vTabOrder) + 1

On Error Resume Next
m = Application.Match(ActiveCell.Address(0, 0), vTabOrder, False)
On Error GoTo ExitSub

'--if activecell is not in Tab Order return to the first cell
If IsError(m) Then
   m = 1
Else
   '--get adjustment to index
   iAdjust = IIf(iDirection = xlPrevious, -1, 1)

   '--calculate new index wrapping around list
   m = (m + lItems + iAdjust - 1) Mod lItems + 1
End If

'--select cell adjusting for Option Base 0 or 1
Application.EnableEvents = False
Range(vTabOrder(m + (LBound(vTabOrder) = 0))).Select

ExitSub:
   Application.EnableEvents = True
End Sub

Please let me know your thoughts.

Dave- thanks again for the idea of using OnKeys. I hadn't tried it previously and I'm sure to use it again soon!

 

[dmt32]

Hi,
Like what you have done & certainley cleaner - just couple of comments:

1 - working in an unprotected sheet I thought OP did not want users to be able to select cells other than those in array.

2 - code does not seem to deactivate SetOnkey when you change sheet.

Dave