VBA Code for Tab order

kevindow · Nov 13, 2013

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 · Sep 1, 2014

Hi Rick, The OP explained the desire to move to the next cell in the tab order without making a change to the active cell (by keying Tab or one of the arrow keys). That's why the Change event approach was discarded.

My first suggestion was to couple Change and Selection events. That could work, but the approach of using OnKey suggested by Dave seems much simpler.

Rick Rothstein · Sep 1, 2014

Jerry Sullivan said:
Hi Rick, The OP explained the desire to move to the next cell in the tab order without making a change to the active cell (by keying Tab or one of the arrow keys). That's why the Change event approach was discarded.

My first suggestion was to couple Change and Selection events. That could work, but the approach of using OnKey suggested by Dave seems much simpler.

Thanks for the clarification... the thread is too long to read in detail, so I tried skimming it to get a sense of things and, obviously, I missed something.

Jerry Sullivan · Sep 1, 2014

99moorem said:
Hi,

The only problem I seem to be having with this code is because it is always running I can not select any of my buttons to run my code. For example to go back to the main menu? Or to publish the document.

Do you think there is anyway to detect (or catch the error, just standard cant excute in break mode) when a button is clicked and turn the tab order macro off?

Personally I do not know of any events that trigger when a button is clicked. And they would not fire as you are already running code? correct me if wrong.

Any help would be greatly appreciated.

Thanks

Marc

Marc, I'm not following why the code isn't allowing you to click a button. Could you explain the problem in more detail?

99moorem · Sep 3, 2014

Hi Jerry,

Once I had implmented the code my VBA window says "(running)" as it does when code is running. I can not break the code to see where it is. and I can not click any buttons on my spreadsheet (only macro assigned buttons, bold etc still work).

I do not know if it matters but the buttons are pictures with macros assigned to them.

Im not quite sure what more information you require? (or what else I can give you?) Happy to provide info if you let me know what you need.

Im using Excel 2007 if that helps.

Thanks

Marc

Jerry Sullivan · Sep 4, 2014

Marc, You shouldn't get that behavior from the code shown in this thread alone.

If setup as intended, the code sets the action that various keystrokes will trigger, but the code shouldn't be always (running).

You might have created a endless loop through modifying the code for your purpose, or through interaction with other code in your workbook or VBA Project.

Usually keying Ctrl-Break will break the code and from there you can step through the code one line at time using the F8 key.

If you aren't able to use Ctrl-Break to break the code, try adding breakpoints to the first line of each procedure prior to taking any actions that will trigger events.

If necessary, you can disable events prior to opening that workbook using Application.EnableEvents=False, then open the workbook and add breakpoints, then restore events with Application.EnableEvents=True

99moorem · Sep 4, 2014

Hmm,

I will try it in a blank workbook and give feedback then. I may have just implemeted it incorrectly.

Thanks for the help

Marc

99moorem · Sep 4, 2014

Hi,

I tried in a new workbook. It worked like a dream. Went back to my workbook confused, implemented it the same way and it also works good.

However it has disabled some of my userforms from popping up, due to the enable events, It also does not account for locked cells which may become unlocked later, just add them into the array and the macro will skip if they are locked. I have code elsewhere that unlocks them before this runs so it all works nicely together.

Below is my code, I have added functionality for 2 concurrent locked (or unlocked depending on circumstance) cells (anymore break it but it sufficed for me, im sure there is a better way) and it also has functionality for userforms being triggered on cell selection.

Code:

Option Explicit
Public Function bIsTabOrderValue(ByVal wks As Worksheet) As Boolean
   Dim avValueList 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.
   avValueList = Array("Big E Crane", "Concrete Pump", "Crawler Crane", "Mobile Crane", "Self Erecting", "Spider Crane", "Cropper", "Dumper and Rollers", "Excavator", "Generator", "Hoist", "Mast Climber", "Scissor And Boom", "Forklift")
      bIsTabOrderValue = _
      IsNumeric(Application.Match(wks.Name, avValueList, 0))
      
End Function
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("Tab_Order").Range("A1").Value
 Select Case sNumber
   Case "Big E Crane"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Concrete Pump"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Crawler Crane"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Mobile Crane"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Self Erecting"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Spider Crane"
      GetTabOrder = Array("J4", "J5", "J7", "J8", "J9", "J10", "S6", "S7", "S9", "S10", "B24", "E31", "K31", "E32", "K32", "Q32", "F37", "J37", "N37", "R37", "F38", "J38", "N38", "R38", "F39", "J39", "N39", "R39", "F40", "J40", "N40", "R40", "F41", "J41", "N41", "R41", "F42", "J42", "N42", "R42", "B46", "I54", "S54", "I55", "S55")
   Case "Cropper"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "R30", "E30", "E31", "E32", "B44", "H50", "R50", "H51", "R51")
   Case "Dumper and Rollers"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "Q30", "Q34", "B39", "H45", "R45", "H46", "R46")
   Case "Excavator"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "D30", "D31", "D32", "M32", "B42", "H49", "R49", "H50", "R50")
   Case "Generator"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "L31", "O31", "L32", "O32", "L33", "O33", "Q38", "Q39", "B45", "H50", "R50", "H51", "R51")
   Case "Hoist"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "Q31", "Q32", "Q33", "D34", "D35", "S36", "S37", "R38", "R39", "B43", "H49", "R49", "H50", "R50")
    Case "Mast Climber"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "C31", "P31", "C32", "P32", "P33", "R35", "P36", "P37", "P38", "B43", "H48", "R48", "H49", "R49")
    Case "Scissor And Boom"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "L30", "Q30", "F31", "H36", "H37", "H38", "S36", "S37", "S38", "B42", "H49", "R49", "H50", "R50")
    Case "Forklift"
      GetTabOrder = Array("I5", "I6", "I8", "I9", "I10", "I11", "R6", "R7", "R9", "R10", "D17", "E19", "K19", "E20", "K20", "Q20", "R25", "P31", "T31", "P32", "T32", "J32", "J33", "K39", "Q39", "B43", "H49", "R49", "H50", "R50")
   Case Else
      MsgBox "Error"
   End Select
End Function
Public Function Load_Calendar_Userform() As Variant
 Dim sNumber As String
 sNumber = Sheets("Tab_Order").Range("A1").Value
 Select Case sNumber
   Case "Big E Crane"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Concrete Pump"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Crawler Crane"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Mobile Crane"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Self Erecting"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Spider Crane"
      Load_Calendar_Userform = Array("S6", "S55")
   Case "Cropper"
      Load_Calendar_Userform = Array("R6", "R51")
   Case "Dumper and Rollers"
      Load_Calendar_Userform = Array("R6", "R46")
   Case "Excavator"
      Load_Calendar_Userform = Array("R6", "R50")
   Case "Generator"
      Load_Calendar_Userform = Array("R6", "R51")
   Case "Hoist"
      Load_Calendar_Userform = Array("R6", "R50")
    Case "Mast Climber"
      Load_Calendar_Userform = Array("R6", "R49")
    Case "Scissor And Boom"
      Load_Calendar_Userform = Array("R6", "R50")
    Case "Forklift"
      Load_Calendar_Userform = Array("R6", "R50")
   Case Else
      MsgBox "Error"
   End Select
End Function
Public Function Load_Dimension_Userform() As Variant
 Dim sNumber As String
 sNumber = Sheets("Tab_Order").Range("A1").Value
 Select Case sNumber
   Case "Big E Crane"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Concrete Pump"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Crawler Crane"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Mobile Crane"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Self Erecting"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Spider Crane"
      Load_Dimension_Userform = Array("F39", "J39", "N39", "R39")
   Case "Cropper"
      Load_Dimension_Userform = Array("")
   Case "Dumper and Rollers"
      Load_Dimension_Userform = Array("")
   Case "Excavator"
      Load_Dimension_Userform = Array("")
   Case "Generator"
      Load_Dimension_Userform = Array("")
   Case "Hoist"
      Load_Dimension_Userform = Array("")
    Case "Mast Climber"
      Load_Dimension_Userform = Array("")
    Case "Scissor And Boom"
      Load_Dimension_Userform = Array("")
    Case "Forklift"
      Load_Dimension_Userform = Array("")
   Case Else
      MsgBox "Error"
   End Select
End Function
Sub Check_Forms(vTabOrder, i)
Dim vDim_Form As Variant, F As Integer, vCal_Form As Variant
'Ver 1 - Marc Moore Aka 99moorem 04-09-2014
'Used to load on Events but events must be disabled below is the same functionality
'for my two userforms
vDim_Form = Load_Dimension_Userform
For F = 0 To UBound(vDim_Form)
    If vDim_Form(F) = vTabOrder(i) Then
        OpenDimension Range(vTabOrder(i)), Range(vTabOrder(i)).Value
        Exit For
    End If
Next
vCal_Form = Load_Calendar_Userform
For F = 0 To UBound(vCal_Form)
    If vCal_Form(F) = vTabOrder(i) Then
        OpenCalender Range(vTabOrder(i))
        Exit For
    End If
Next
End Sub
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)
   'range locked increment i
   If Range(vTabOrder(i)).Locked Then
   i = i + IIf(TabDirection = xlPrevious, -1, 1)
   End If
   ' second range locked increment i
   If Range(vTabOrder(i)).Locked Then
   i = i + IIf(TabDirection = xlPrevious, -1, 1)
   End If
   '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
 Check_Forms vTabOrder, i
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

Still not sure why it did not work the first time the code is exactly the same..... minus my changes after I got it working of course

Seems like alot of code needed for something Microsoft could have put in with prob no hassle

Let me know your thoughts.

and thanks again for your help.

Marc aka 99moorem

Rick Rothstein · Sep 4, 2014

Jerry Sullivan said:
Hi Rick, The OP explained the desire to move to the next cell in the tab order without making a change to the active cell (by keying Tab or one of the arrow keys). That's why the Change event approach was discarded.

Here is an alternate method of doing almost what the OP asked for that you, the OP or other readers of this thread may find interesting. The way it works is once you select one of the cells in the specified TabOrder variable, any change in selection to a single cell (no matter how initiated... Tab key, Enter key, Arrow key, Mouse Click, etc.) will take you to the next cell in the tab order. If the user needs to "break out" of the tab order cycle, all they need to do is select any two or more cells. Selecting any one of the cells in the tab order will reinstitute the TabOrder cycle again and selecting two or more cells again will break it, and so on, and so on. The code to do this is as follows...

Place in the Sheet Module

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim TabOrder As String
  If PreviouslySelectedCell Is Nothing Then Set PreviouslySelectedCell = Cells(Rows.Count, Columns.Count)
  If Target.Count > 1 Then
    Set PreviouslySelectedCell = ActiveCell
    Exit Sub
  ElseIf Not Intersect(PreviouslySelectedCell, Range("C10,K4,A13,E7")) Is Nothing Then
    TabOrder = "C10,K4,A13,E7"
    TabOrder = "," & Replace(Replace(TabOrder & "," & Split(TabOrder, ",")(0), "$", ""), " ", "")
    If InStr(TabOrder, "," & PreviouslySelectedCell.Address(0, 0) & ",") Then
      Range(Split(Split(TabOrder, "," & PreviouslySelectedCell.Address(0, 0) & ",")(1), ",")(0)).Select
    End If
    Set PreviouslySelectedCell = ActiveCell
    Exit Sub
  Else
    Set PreviouslySelectedCell = Target
  End If
End Sub

Place at the top of a General Module

Code:

Public PreviouslySelectedCell As Range

99moorem · Sep 4, 2014

Rick,

Just one question on your method. How about uses that would use this to their advantage? e.g. maliciously? clicking two cells to get out of a tab order would be too easy for some of my clients/projects. lol!

I know the other method does let you select multiple cells but it always brings you back to the tab order.

It would however keep the events firing

Thanks

Marc

99moorem · Sep 4, 2014

Hi,

If you use something like below on these you can toggle them on and off eaiser too.

Code:

If bIsTabOrderValue(ActiveSheet) And ws_Tab_Order.Range("B1").Value Then SetOnkey True

Where B1 is just true or false.

Thanks

Marc

VBA Code for Tab order

kevindow

New Member

Jerry Sullivan

MrExcel MVP

Excel Facts

Rick Rothstein

MrExcel MVP

Jerry Sullivan

MrExcel MVP

99moorem

New Member

Jerry Sullivan

MrExcel MVP

99moorem

New Member

99moorem

New Member

Rick Rothstein

MrExcel MVP

99moorem

New Member

99moorem

New Member

Similar threads

Forum statistics

Share this page

VBA Code for Tab order

New Member

MrExcel MVP

Excel Facts

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

MrExcel MVP

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock