PDA

View Full Version : Set Tab Order



Forbesdi6
04-30-2014, 07:05 AM
Let me say up front that I'm new to coding! I'm having trouble with tab order in a spreadsheet. I have the following code but it only works if something is entered in the field. If there is no entry and you press tab to go to the next field it defaults to normal excel behavior and moves left to right. Thanks for any guidance!


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("B4", "M4", "B6", "K6", "B8", "K8", "O8", "P8", "B10", "B12", "I12", "K12", "M12", "B14", "K14", "B16", "E16", "I16", "K16", "B18", "C20", "L20", "B22", "L22", "E23", "L23", "B25", "L25", "H26", "J26", "D28", "F28", "H28", "J28", "D29", "F29", "H29", "J29", "B30", "L30", "G31", "J31", "F32", "L32", "B33", "L33", "B34", "L34", "P22", "P23", "M26", "P26", "M28", "P28", "M29", "P29", "M31", "P31", "M32", "P32", "M33", "P33", "M34", "M34")

'Loop through the array of cell address
For i = LBound(aTabOrd) To UBound(aTabOrd)
'If the cell that's changed is in the array
If aTabOrd(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

GTO
04-30-2014, 05:36 PM
Hi there,

Not feeling overly bright today, so probably not thinking all the way through, but for a quick test on a junk/throwaway copy of your workbook...

In ThisWorkbook Module:


Option Explicit

Private Sub Workbook_Open()
Dim Index As Long

If ActiveSheet.CodeName = "Sheet1" Then
Set Sheet1.CurrentCell = ActiveCell
Else
Index = ActiveSheet.Index
Sheet1.Activate
DoEvents
ThisWorkbook.Sheets(Index).Activate
End If

End Sub


In the Worksheet's Module:


Option Explicit

Private OldSelectedCell As Range

Public Property Set CurrentCell(Cell As Range)
Set OldSelectedCell = Cell
End Property

Private Sub Worksheet_Activate()
Set OldSelectedCell = ActiveCell
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CurrentAddress() As Variant, NextAddress() As Variant
Dim Index As Long
CurrentAddress = Array("B4", "M4", "B6", "K6", "B8", "K8", "O8", "P8", "B10", "B12", "I12", "K12", "M12", "B14", "K14", "B16", "E16", "I16", "K16", "B18", "C20", "L20", "B22", "L22", "E23", "L23", "B25", "L25", "H26", "J26", "D28", "F28", "H28", "J28", "D29", "F29", "H29", "J29", "B30", "L30", "G31", "J31", "F32", "L32", "B33", "L33", "B34", "L34", "P22", "P23", "M26", "P26", "M28", "P28", "M29", "P29", "M31", "P31", "M32", "P32", "M33", "P33", "M34")
NextAddress = Array("M4", "B6", "K6", "B8", "K8", "O8", "P8", "B10", "B12", "I12", "K12", "M12", "B14", "K14", "B16", "E16", "I16", "K16", "B18", "C20", "L20", "B22", "L22", "E23", "L23", "B25", "L25", "H26", "J26", "D28", "F28", "H28", "J28", "D29", "F29", "H29", "J29", "B30", "L30", "G31", "J31", "F32", "L32", "B33", "L33", "B34", "L34", "P22", "P23", "M26", "P26", "M28", "P28", "M29", "P29", "M31", "P31", "M32", "P32", "M33", "P33", "M34", "B4")

On Error Resume Next
Index = Application.Match(OldSelectedCell.Address(0, 0), CurrentAddress, 0)
On Error GoTo 0

If Not Index = 0 Then
Range(NextAddress(Index - 1)).Select
Set OldSelectedCell = ActiveCell
End If

End Sub

Bob Phillips
05-01-2014, 03:53 AM
I think you can do away with the NextAddress array, but then you need to to cater for Index = 0, go back to start


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CurrentAddress() As Variant, NextAddress() As Variant
Dim Index As Long
CurrentAddress = Array("B4", "M4", "B6", "K6", "B8", "K8", "O8", "P8", _
"B10", "B12", "I12", "K12", "M12", "B14", "K14", "B16", _
"E16", "I16", "K16", "B18", "C20", "L20", "B22", "L22", _
"E23", "L23", "B25", "L25", "H26", "J26", "D28", "F28", _
"H28", "J28", "D29", "F29", "H29", "J29", "B30", "L30", _
"G31", "J31", "F32", "L32", "B33", "L33", "B34", "L34", _
"P22", "P23", "M26", "P26", "M28", "P28", "M29", "P29", _
"M31", "P31", "M32", "P32", "M33", "P33", "M34")

On Error Resume Next
Index = Application.Match(OldSelectedCell.Address(0, 0), CurrentAddress, 0)
On Error GoTo 0

If Not Index = 0 Then
Range(CurrentAddress(Index)).Select
Else
Me.Range(CurrentAddress(LBound(CurrentAddress))).Select
End If
Set OldSelectedCell = ActiveCell
End Sub

GTO
05-01-2014, 01:06 PM
I think you can do away with the NextAddress array, but then you need to to cater for Index = 0, go back to start...

Greetings and Salutations my friend,

I remain unconvinced that mine was near best, as I am not sure of the OP's intent at this point: If we are in one of the cells listed, I know we want to select the next wanted cell, but... if I pick a cell not listed, it of course jumps to the next listed cell. Sorry, I know that just sounds goofy, but what I am trying to say is that the OP might still want to pick other cells, and have our 'custom tabbing order' only work upon the TAB or ENTER keys whilst in one of the cells listed. Hopefully my muddled wording is decipherable...

Anyways, I am pretty sure that when we TAB/ENTER whilst in P33, Index becomes 62 and M34 is selected. But when you TAB from M34, Index becomes 63, which causes :stars:= CurrentAddress(Index)


Sorry, I just couldn't resist a dopey joke there :-)

Mark

Kenneth Hobs
05-01-2014, 01:54 PM
For my method, I select the range if the cursor selects one of the cells in the set tab order's range and all are shaded and ready for tab order selection methods. I would recommend locking all other cells though that is how most do this sort of thing anyway.

Notice that you can set both continuous and discontinuous cells for the tab order range. It just depends on your order.

Right click the sheet's tab, View > Code, and paste:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, r1 As Range, r2 As Range, r3 As Range
Dim r4 As Range, r5 As Range, r6 As Range, r7 As Range
Dim r8 As Range, ac As Range, ri As Range

Set r1 = Range("B4, M4, B6, K6, B8, K8, O8:P8")
Set r2 = Range("B10, B12, I12, K12, M12, B14, K14, B16")
Set r3 = Range("E16, I16, K16, B18, C20, L20, B22, L22")
Set r4 = Range("E23, L23, B25, L25, H26, J26, D28, F28")
Set r5 = Range("H28, J28, D29, F29, H29, J29, B30, L30")
Set r6 = Range("G31, J31, F32, L32, B33, L33, B34, L34")
Set r7 = Range("P22, P23, M26, P26, M28, P28, M29, P29")
Set r8 = Range("M31, P31, M32, P32, M33, P33, M34")
Set r = Union(r1, r2, r3, r4, r5, r6, r7, r8)
Set ri = Intersect(Target, r)
If ri Is Nothing Then Exit Sub

Application.EnableEvents = False

Set ac = ActiveCell
Application.Goto r
ac.Activate

Application.EnableEvents = True
End Sub