VBA Code for Tab order

kevindow

New Member
Joined
Nov 13, 2013
Messages
9
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


 
Hi avalenti and Welcome to MrExcel,

Well done on figuring out one way to adapt the code for multiple worksheets. :) It's very nice of you to share your solution for others who find this thread.

Your approach could work well for two worksheets. Here's another approach which attempts to minimize duplication of code making it easier to maintain and scale to many worksheets.

In the ThisWorkbook Module
Code:
Private Sub Workbook_Open()
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   If bIsTabOrderSheet(Sh) Then SetOnkey True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
   If bIsTabOrderSheet(Sh) Then SetOnkey False
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey True
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey False
End Sub

In a Standard Code Module (only the first two procedures are different, but I've reposted all code needed for the system).

Code:
Public Function bIsTabOrderSheet(ByVal wks As Worksheet) As Boolean
   Dim avSheetList As Variant
   avSheetList = Array("Sheet1", "Sheet2", "Sheet3", "Sheet6")
   bIsTabOrderSheet = _
      IsNumeric(Application.Match(wks.Name, avSheetList, 0))
End Function

Public Function GetTabOrder() As Variant
'--set the tab order of input cells - change ranges as required
   Select Case ActiveSheet.Name
      Case "Sheet1"
         GetTabOrder = Array("D8", "F8", "H8", "I10", "J5", "L6", "L8", "D12", _
            "D18", "F18", "E19", "H18", "L16", "I19", "L18", "D22", _
            "D28", "F28", "H28", "L26", "L28", "D32")
      Case "Sheet2", "Sheet3"
         GetTabOrder = Array("D8", "F8", "L6", "H8", "J5", "I10", "L8", "D12")
      Case "Sheet6"
         GetTabOrder = Array("D18", "F18", "E19", "H18", "L16", "D22")
      Case Else
         MsgBox "Error: Tab Order has not be specified for this sheet."
   End Select
End Function

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}", "'UpOrDownArrow xlDown'"
            .OnKey "{UP}", "'UpOrDownArrow xlUp'"
        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 TabRange(Optional iDirection As Integer = xlNext)

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

'--get the tab order from shared function
vTabOrder = GetTabOrder

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

Sub UpOrDownArrow(Optional iDirection As Integer = xlUp)

Dim vTabOrder As Variant
Dim lRowClosest As Long, lRowTest As Long
Dim i As Long, iSign As Integer

Dim sActiveCol As String
Dim bFound As Boolean

'--get the tab order from shared function
vTabOrder = GetTabOrder

'--find TabCells in same column as ActiveCell in iDirection
'--  rTest will include ActiveCell

sActiveCol = GetColLtr(ActiveCell.Address(0, 0))

iSign = IIf(iDirection = xlDown, -1, 1)
lRowClosest = IIf(iDirection = xlDown, Rows.Count + 1, 0)

For i = LBound(vTabOrder) To UBound(vTabOrder)
   If GetColLtr(CStr(vTabOrder(i))) = sActiveCol Then
      lRowTest = Range(CStr(vTabOrder(i))).Row
         
   '--find closest cell to ActiveCell in rTest
      If iSign * lRowTest > iSign * lRowClosest And _
         iSign * lRowTest < iSign * ActiveCell.Row Then
         '--at least one cell in iDirection of same columnn
         bFound = True
         lRowClosest = lRowTest
      End If
   End If
Next i

If bFound Then
   Application.EnableEvents = False
   Cells(lRowClosest, ActiveCell.Column).Select
   Application.EnableEvents = True
End If
End Sub

Private Function GetColLtr(sAddr As String) As String
Dim iPos As Long, sTest As String

Do While iPos < 3
   iPos = iPos + 1
   If IsNumeric(Mid(sAddr, iPos, 1)) Then
      Exit Do
   Else
      sTest = sTest & Mid(sAddr, iPos, 1)
   End If
Loop

GetColLtr = sTest
 
End Function

This eliminates the need for any procedures in the Sheet Code module. So delete those if you have them from the earlier examples.

Hope to see more of your participation in this forum!
 
Last edited:
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Thank you so much for your help. It works perfectly!

I added the Enter as a OnKey as well.

I had a weird glitch though. When I would hit the left or right arrow keys I would get a error. Could of been from adding my range and not restarting excel...

Either way thanks a lot. I have been trying to get this to work for quite some time on my own.

I finally gave in and subscribed here. Thankfully I did.
 
Upvote 0
I had a weird glitch though. When I would hit the left or right arrow keys I would get a error. Could of been from adding my range and not restarting excel...

What was the specific Error Number and Description message? When you get that error then click the Debug button, which line of the code is highlighted?
 
Upvote 0
It seems many people have found this code helpful and in looking back at the last several posts, I’ve realized that I didn’t properly credit Dave Timms (DMT32 on MrExcel) for the original code and concept.

In Post #3 of this thread, Dave suggested using OnKey instead of a Worksheet_SelectionChange event. At that time I had only a foggy notion of the use of OnKey. Dave offered code that he’d used successfully and previously offered to other posters looking for a better way to create a custom tab order on unprotected worksheets.

I typically add line at the beginning of a main VBA procedure attributing the source when I’ve modified someone else’s code- usually with a link to the URL where the source is located. The thought of doing that didn’t strike me at the beginning of this thread when Dave and I were helping the OP to adapt the code for his specific purpose and his role as originator of the code was clear to see. Now that the thread is at Post #34, it would be easy for someone finding the last few posts to mistake me as the author of the code.

I’ve reposted the code below with proper attribution. This latest version includes improvements that Dave suggested to the TabRange function that make it clearer to follow.

Many thanks Dave! :)

In a Standard Code Module
Code:
Option Explicit

Public Function GetTabOrder() As Variant
'  Ver 2 2014 - Dave Timms (aka DMT32) and  Jerry Sullivan
'--set the tab order of input cells - change ranges as required
'  do not use "$" in the cell addresses.

   Select Case ActiveSheet.Name
      Case "Sheet1"
         GetTabOrder = Array("D8", "F8", "H8", "I10", "J5", "L6", "L8", "D12", _
            "D18", "F18", "E19", "H18", "L16", "I19", "L18", "D22", _
            "D28", "F28", "H28", "L26", "L28", "D32")
      Case "Sheet2", "Sheet3"
         GetTabOrder = Array("D8", "F8", "L6", "H8", "J5", "I10", "L8", "D12")
      Case "Sheet6"
         GetTabOrder = Array("D18", "F18", "E19", "H18", "L16", "D22")
      Case Else
         MsgBox "Error: Tab Order has not been specified for this sheet."
   End Select
End Function

Public Function bIsTabOrderSheet(ByVal wks As Worksheet) As Boolean
   Dim avSheetList As Variant
'--edit this list with the names of the sheets to which a custom tab order
'  should be applied. Each of these sheets should also have a sequence of
'  cell addresses listed in a Case statement in Function GetTabOrder.

   avSheetList = Array("Sheet1", "Sheet2", "Sheet3", "Sheet6")
   bIsTabOrderSheet = _
      IsNumeric(Application.Match(wks.Name, avSheetList, 0))
End Function

Sub SetOnkey(ByVal state As Boolean)
'  Ver 2 2014 - Dave Timms (aka DMT32) and  Jerry Sullivan
    If state Then
        With Application
            .OnKey "{TAB}", "'TabRange xlNext'"
            .OnKey "~", "'TabRange xlNext'"
            .OnKey "{RIGHT}", "'TabRange xlNext'"
            .OnKey "{LEFT}", "'TabRange xlPrevious'"
            .OnKey "{DOWN}", "'UpOrDownArrow xlDown'"
            .OnKey "{UP}", "'UpOrDownArrow xlUp'"
        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 TabRange(ByVal TabDirection As Integer)
'  Ver 2 2014 - Dave Timms (aka DMT32) and  Jerry Sullivan
 Dim vTabOrder As Variant, m As Variant, i As Long

 vTabOrder = GetTabOrder
 On Error Resume Next
 m = Application.Match(ActiveCell.Address(0, 0), vTabOrder, False)
 On Error GoTo ExitSub
 'if activecell is not in Taborder array start at first cell
 If IsError(m) Then
   'goto first cell in array
   m = LBound(vTabOrder)
 Else
   'get corresponding array index
   i = m + LBound(vTabOrder) - 1
   'increment i value based on tabdirection
   i = i + IIf(TabDirection = xlPrevious, -1, 1)
   'ensure stay within array bounds
   If i > UBound(vTabOrder) Then
      i = LBound(vTabOrder)
   ElseIf i < LBound(vTabOrder) Then
      i = UBound(vTabOrder)
   End If
End If
 'select cell based on array element
 Application.EnableEvents = False
 Range(vTabOrder(i)).Select
ExitSub:
 Application.EnableEvents = True
End Sub

Sub UpOrDownArrow(Optional iDirection As Integer = xlUp)

Dim vTabOrder As Variant
Dim lRowClosest As Long, lRowTest As Long
Dim i As Long, iSign As Integer

Dim sActiveCol As String
Dim bFound As Boolean

'--get the tab order from shared function
vTabOrder = GetTabOrder

'--find TabCells in same column as ActiveCell in iDirection
'--  rTest will include ActiveCell

sActiveCol = GetColLtr(ActiveCell.Address(0, 0))

iSign = IIf(iDirection = xlDown, -1, 1)
lRowClosest = IIf(iDirection = xlDown, Rows.Count + 1, 0)

For i = LBound(vTabOrder) To UBound(vTabOrder)
   If GetColLtr(CStr(vTabOrder(i))) = sActiveCol Then
      lRowTest = Range(CStr(vTabOrder(i))).Row
         
   '--find closest cell to ActiveCell in rTest
      If iSign * lRowTest > iSign * lRowClosest And _
         iSign * lRowTest < iSign * ActiveCell.Row Then
         '--at least one cell in iDirection of same columnn
         bFound = True
         lRowClosest = lRowTest
      End If
   End If
Next i

If bFound Then
   Application.EnableEvents = False
   Cells(lRowClosest, ActiveCell.Column).Select
   Application.EnableEvents = True
End If
End Sub

Private Function GetColLtr(sAddr As String) As String
Dim iPos As Long, sTest As String

Do While iPos < 3
   iPos = iPos + 1
   If IsNumeric(Mid(sAddr, iPos, 1)) Then
      Exit Do
   Else
      sTest = sTest & Mid(sAddr, iPos, 1)
   End If
Loop

GetColLtr = sTest
 
End Function

In the ThisWorkbook Module
Code:
Private Sub Workbook_Open()
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
   If bIsTabOrderSheet(Sh) Then SetOnkey True
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
   If bIsTabOrderSheet(Sh) Then SetOnkey False
End Sub

Private Sub Workbook_WindowActivate(ByVal Wn As Window)
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey True
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
   If bIsTabOrderSheet(ActiveSheet) Then SetOnkey False
End Sub
 
Upvote 0
It seems many people have found this code helpful and in looking back at the last several posts, I’ve realized that I didn’t properly credit Dave Timms (DMT32 on MrExcel) for the original code and concept.

Hi Jerry,</SPAN>
You are a true gentlemen & I thank you for your kindness in given consideration for my involvement in this solution. Whilst I may have posted the original concept I think it fair to say that you took it to another level and clearly judging from responses, many on this board have found both your generous time and assistance adapting the code for their particular need, extremely helpful.</SPAN>

Hopefully, the updated Tab Range code I suggested will be easier for Op’s to follow but I have been working on a version where user can “record” the tab ranges by clicking cells with the mouse negating the need for hard coding the ranges. </SPAN>

Further more, the solution allows for many unprotected sheets in a workbook with different tab selections requirements to be made. This approach should help those Ops’s who find modifying VBA a little daunting.</SPAN>

What I have is at an early stage & bit rough around the edges but I will send copy to you when have a moment and would very much appreciate your input / feedback. Perhaps if think worthy, we can post final version to the board.</SPAN>

Once again, many thanks</SPAN>


Dave</SPAN>
 
Upvote 0
What was the specific Error Number and Description message? When you get that error then click the Debug button, which line of the code is highlighted?

It only happened a couple times. I can not recreate the issue so I am assuming it was user error...

Thanks for the help.
 
Upvote 0
Hi Jerry Sullivan & Dave Timms, I am currently working on a document and would like to use this taborder. The code in this thread is based on a sheetname, however I would like it to be a based on a cellvalue. I have been trying, but haven’t figured it out yet. This is what I've done so far:
Code:
 Public Function GetTabOrder() As Variant '  Ver 2 2014 - Dave Timms (aka DMT32) and  Jerry Sullivan '--set the tab order of input cells - change ranges as required '  do not use "$" in the cell addresses. Dim Number Number = Sheets("mutatieformulier").Range("T11").Value     Select Case Number     Case "0"         GetTabOrder = Array("I7", "G11")     Case "1"         GetTabOrder = Array("G11", "G13", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", "G24", _         "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37", "G44", "G45", "G46", "J47", _         "O44", "O45", "O46")          Case "2"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "O13", "O14", "O15", "O16", "O17", "G27", "G28", "G29")      Case "3"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "O13", "O14", "O15", "O16", "O17", "G27", "G28", "G29")      Case "4"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "O18", "O19", "G27", "G28", "G29")      Case "5"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "O23", "G27", "G28", "G29")      Case "6"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "O23", "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37")             Case "7"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "G27", "G28", "G29")            Case "8"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "G27", "G28", "G29", "O29", "O31", "O32")      Case "9"         GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _         "G24", "G27", "G28", "G29", "O28", "O29", "O31", "O32")             Case "10"         GetTabOrder = Array("G11", "G13", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", "G24", _         "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37", "O13", "O14", "O17", "O29", "O31", _         "O32", "G44", "G45", "G46", "J47", "O44", "O45", "O46")      Case Else          MsgBox "Error: Tab Order has not been specified for this sheet."    End Select End Function
And so far: it is not working for me. :( I am quite new to VBA and probably doing something terribly wrong... Anyway, I would appreciate any help
 
Upvote 0
I do not understand why all code is in one line. Is it me, or is there a problem?

Hi Driesumdre, The code might have lost it's LineFeeds if you pasted it from a text editor like NotePad.

The code you have looks like it should work provided that you have a value between 0 and 10 in Cell T11 of Sheet "mutatieformulier" of the ActiveWorkbook.

I'd suggest you explicitly declare the variable as a String data type; however it should have worked without that modification.
You said so far it wasn't working for you - what happened when you ran it?

Code:
 Public Function GetTabOrder() As Variant
 '  Ver 2 2014 - Dave Timms (aka DMT32) and  Jerry Sullivan
 '--set the tab order of input cells - change ranges as required
 '  do not use "$" in the cell addresses.
 
 Dim sNumber As String
 sNumber = Sheets("mutatieformulier").Range("T11").Value
 Select Case sNumber
   Case "0"
      GetTabOrder = Array("I7", "G11")
   Case "1"
      GetTabOrder = Array("G11", "G13", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", "G24", _
         "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37", "G44", "G45", "G46", "J47", _
         "O44", "O45", "O46")
   Case "2"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "O13", "O14", "O15", "O16", "O17", "G27", "G28", "G29")
   Case "3"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "O13", "O14", "O15", "O16", "O17", "G27", "G28", "G29")
   Case "4"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "O18", "O19", "G27", "G28", "G29")
   Case "5"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
      "G24", "O23", "G27", "G28", "G29")
   Case "6"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "O23", "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37")
   Case "7"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "G27", "G28", "G29")
   Case "8"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "G27", "G28", "G29", "O29", "O31", "O32")
   Case "9"
      GetTabOrder = Array("G11", "G13", "G14", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", _
         "G24", "G27", "G28", "G29", "O28", "O29", "O31", "O32")
   Case "10"
      GetTabOrder = Array("G11", "G13", "G15", "G16", "G17", "G18", "G19", "G20", "G21", "G22", "G23", "G24", _
      "G27", "G28", "G29", "G33", "G34", "G35", "G36", "G37", "O13", "O14", "O17", "O29", "O31", _
      "O32", "G44", "G45", "G46", "J47", "O44", "O45", "O46")
   Case Else
      MsgBox "Error: Tab Order has not been specified for this sheet."
   End Select
End Function
 
Upvote 0
Hi Jerry,
Thanks for picking this up - not sure what it is with Mr Excel but I do not always get my email alerts including this one.

Trust well

Dave
 
Upvote 0

Forum statistics

Threads
1,224,810
Messages
6,181,079
Members
453,021
Latest member
Justyna P

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