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]

Dave,

I pasted the ThisWorkBook code twice by mistake. This Sheet Code should be....

Private Sub Worksheet_Activate()
    SetOnkey True
End Sub

 
Private Sub Worksheet_Deactivate()
    SetOnkey False
End Sub

Regarding allowing the user to Click to select of cells other than those in the Tab Order, I interpreted the OP note "Another problem is if I enter data inside a cell that is not listed in the code it gives an error message", as indicating the desire to be able to enter values in cells other than those in Tab Order. The code could be modified to suit whatever behavior is desired when such a Cell is clicked.

 

[kevindow]

Tried running the cleaner code by JS411 and received a "Compile error: Only comments may appear after end Sub, End function, or End Property.

The following is what I entered into VBA:

Sheet One Code:

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



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

This Workbook code:

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



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

Module 1 Code:

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("B53", "N53", "Z53", "B42", "N42", "Z42", "B31", "N31", "Z31")
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
'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

Hope this makes sense.

 

[Jerry Sullivan]

Is it possible you've pasted all that code in one place including the text like "Sheet One Code:"? That would generate that error.

Parts of the code needs to be pasted into each of 3 code modules. In the VB Editor Project Explorer, you'll see icons labeled something like this:
ThisWorkbook
Sheet1 (Seating Chart Q1)
Module1

Each of the 3 parts of the code that I posted needs to be pasted separately into each of those code modules.

Also note my correction in post #11. The code shown there should be pasted in to the Sheet Code Module for "Sheet1 (Seating Chart Q1)"

Are you understanding that the code needs to be pasted into 3 separate

 

[kevindow]

Whoops it was my mistake. I have to make sure that the following code below is in the "This Workbook" module not the "Sheet1 (Seating Chart Q1). I had the two reversed. When put in the correct place the code is working like a charm. Thank you


Private Sub Workbook_WindowActivate(ByVal Wn As Window)If ActiveSheet.Name = "Sheet1" Then SetOnkey TrueEnd Sub Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)SetOnkey FalseEnd Sub</pre>

 

[Jerry Sullivan]

I'm glad to hear that worked.

I just noticed in this Sub, the Sheet name needs to changed to match the name of your sheet using the Tab Order.

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = "[B][COLOR="#0000CD"]Seating Chart Q1[/COLOR][/B]" Then SetOnkey True
End Sub

 

[kevindow]

I have started entering all the cells into the tab array and I reached the limit in which it will allow me to enter a tab sequence (130ish cells). Is there a way to continue the tab order in a new line of code?

 

[Jerry Sullivan]

You can use line continuations like this...

vTabOrder = Array("D8", "F8", "H8", "L6", "L8", _
        "D12", "L6", "L8", "D12", "D8", "F8", _
        "H8", "L6", "L8", "D12", "L6", "L8", "D12")

For an array like this, the underscore should be between a comma and a quote mark.

 

[kevindow]

All your help on the custom tab array has worked like a charm. Is it an easy addition to add one more requirement to the code? Currently if I hit tab, return, or right/left arrow the cell advances to the next cell in the array. Is it possible to add a command that if the user enters the up/down arrows that it will go to the cell closest to the current cell listed in the custom array in a vertical direction up or down?

 

[Jerry Sullivan]

I can try to add something for that. It will help if you can elaborate on the rules that should be used to determine the "closest cell".

Is there any difference between the result of up or down arrow?

Should distance be determined by the sum of rows away from active cell+columns away from active cell?

Do you have a preference which cell to move to if there is more than one cell that is the same "closest" distance?

 

[kevindow]

That is a good question. Can I send you a copy of the document? Perhaps it would be easier to look at, than for me to try and explain.