VBA Code - Effecting entire Workbook not just a Worksheet

M

MDBHR

New Member
Joined
Sep 17, 2018
Messages
10
Office Version
  1. 365
Platform
  1. Windows
So yeah, I'm incredibly new to the code world. I found some VBA Code on this sit for changing the tab order and it worked great! Except that tab order started working on all 6 of the worksheets instead of just the one I had intended. Which is annoying. I think it should be a simple fix. Just cannot figure it out. Any help or suggestions would be greatly appreciated! Here is the code that I currently have running:

In the ThisWorkBook Module...

Code: 
  Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  If ActiveSheet.Name = "Customer Information" Then SetOnkey True
  End Sub
 


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




In the Sheet Module "Customer Information"...

Code: 
  Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  If ActiveSheet.Name = "Customer Information" Then SetOnkey True
  End Sub


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

In a standard code module...
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("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C3", "C4", "C5", "C6", "C7")
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
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Hello MDBHR,

You need to reset the variable if the active sheet is not the one you want.

Change this...
Code: 
  Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  If ActiveSheet.Name = "Customer Information" Then SetOnkey True
  End Sub

To this...
Code: 
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = "Customer Information" Then SetOnkey True Else SetOnKey False
End Sub
 
Upvote 0
Hi,
I worked on this project with Jerry & looks like you have not followed instructions correctly

In the Thisworkbook Module you should have the following codes

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOn
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOff
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = TabSheet Then SetOnkey xlOn
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey xlOff
End Sub


In the standard module at Top of code page you should have the following

Code: 
Public Const TabSheet As String = "TabSheetName"

Change TabSheetName to name of sheet code applies to


dave
 
Last edited:
Upvote 0
In the Worksheet one?

Leith Ross said:
Hello MDBHR,

You need to reset the variable if the active sheet is not the one you want.

Change this...
Code: 
  Private Sub Workbook_WindowActivate(ByVal Wn As Window)
  If ActiveSheet.Name = "Customer Information" Then SetOnkey True
  End Sub

To this...
Code: 
Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = "Customer Information" Then SetOnkey True Else SetOnKey False
End Sub
Click to expand...
 
Upvote 0
Hi Dave,
yes! you were the original creator of the code I do believe. So to be clear, the Standard Module should look like this...
Code: 
Public Const TabSheet As String = "Customer Information"
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("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C3", "C4", "C5", "C6", "C7")
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

dmt32 said:
Hi,
I worked on this project with Jerry & looks like you have not followed instructions correctly

In the Thisworkbook Module you should have the following codes

Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOn
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOff
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = TabSheet Then SetOnkey xlOn
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey xlOff
End Sub


In the standard module at Top of code page you should have the following

Code: 
Public Const TabSheet As String = "TabSheetName"

Change TabSheetName to name of sheet code applies to


dave
Click to expand...
 
Upvote 0
MDBHR said:
Hi Dave,
yes! you were the original creator of the code I do believe. So to be clear, the Standard Module should look like this...
Click to expand...

Hi
Although posted concept project was very much a joint venture.


Post correct but looking through code looks like you have copied a very early version of it.


Try using this version

Place ALL codes in a STANDRAD module

Code: 
Public Const TabSheet As String = "Customer Information"


 Sub SetOnkey(ByVal state As Integer)
 '  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    If state = xlOn Then
        With Application
            .OnKey "{TAB}", "'TabOrder xlNext'"             'Tab key
            .OnKey "+{TAB}", "'TabOrder xlPrevious'"        'Shift + Tab Key
            .OnKey "~", "'TabOrder xlNext'"                 'Enter Key
            .OnKey "{RIGHT}", "'TabOrder xlNext'"           'Right Arrow Key
            .OnKey "{LEFT}", "'TabOrder xlPrevious'"        'Left Arrow Key
            .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 TabOrder(ByVal Direction As XlSearchDirection)
'  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    Dim m As Variant, i As Long


    On Error Resume Next
    m = Application.Match(ActiveCell.Address(0, 0), TabOrderArray, 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
        i = LBound(TabOrderArray)
    Else
'get corresponding array index
        i = m + LBound(TabOrderArray) - 1
'increment i value based on tab direction
        i = i + IIf(Direction = xlPrevious, -1, xlNext)
'ensure stay within array bounds
        If i > UBound(TabOrderArray) Then i = LBound(TabOrderArray)
        If i < LBound(TabOrderArray) Then i = UBound(TabOrderArray)
    End If
    'select cell based on array element
    Application.EnableEvents = False
    Range(TabOrderArray(i)).Select
exitsub:
    Application.EnableEvents = True
End Sub


Function TabOrderArray() As Variant
       TabOrderArray = Array("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C3", "C4", "C5", "C6", "C7")
End Function


Ensure the other codes I published earlier are ALL placed in the Thisworkbook code page Unaltered.

Dave
 
Upvote 0
Hi Dave, this one worked. Thanks a ton for "dummy proofing it" for me!

dmt32 said:
Hi
Although posted concept project was very much a joint venture.


Post correct but looking through code looks like you have copied a very early version of it.


Try using this version

Place ALL codes in a STANDRAD module

Code: 
Public Const TabSheet As String = "Customer Information"


 Sub SetOnkey(ByVal state As Integer)
 '  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    If state = xlOn Then
        With Application
            .OnKey "{TAB}", "'TabOrder xlNext'"             'Tab key
            .OnKey "+{TAB}", "'TabOrder xlPrevious'"        'Shift + Tab Key
            .OnKey "~", "'TabOrder xlNext'"                 'Enter Key
            .OnKey "{RIGHT}", "'TabOrder xlNext'"           'Right Arrow Key
            .OnKey "{LEFT}", "'TabOrder xlPrevious'"        'Left Arrow Key
            .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 TabOrder(ByVal Direction As XlSearchDirection)
'  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    Dim m As Variant, i As Long


    On Error Resume Next
    m = Application.Match(ActiveCell.Address(0, 0), TabOrderArray, 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
        i = LBound(TabOrderArray)
    Else
'get corresponding array index
        i = m + LBound(TabOrderArray) - 1
'increment i value based on tab direction
        i = i + IIf(Direction = xlPrevious, -1, xlNext)
'ensure stay within array bounds
        If i > UBound(TabOrderArray) Then i = LBound(TabOrderArray)
        If i < LBound(TabOrderArray) Then i = UBound(TabOrderArray)
    End If
    'select cell based on array element
    Application.EnableEvents = False
    Range(TabOrderArray(i)).Select
exitsub:
    Application.EnableEvents = True
End Sub


Function TabOrderArray() As Variant
       TabOrderArray = Array("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "C3", "C4", "C5", "C6", "C7")
End Function


Ensure the other codes I published earlier are ALL placed in the Thisworkbook code page Unaltered.

Dave
Click to expand...
 
Upvote 0
Hi Dave, I found this page with your current code on it (Ver 2 2014) and have tried to implement it with no success.

I've created a Module and pasted the following into it. The name of the worksheet I wish to associate this with is named "Calculator".

VBA Code: 
Public Const TabSheet As String = "Calculator"
 Sub SetOnkey(ByVal state As Integer)
 '  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    If state = xlOn Then
        With Application
            .OnKey "{TAB}", "'TabOrder xlNext'"             'Tab key
            .OnKey "+{TAB}", "'TabOrder xlPrevious'"        'Shift + Tab Key
            .OnKey "~", "'TabOrder xlNext'"                 'Enter Key
            .OnKey "{RIGHT}", "'TabOrder xlNext'"           'Right Arrow Key
            .OnKey "{LEFT}", "'TabOrder xlPrevious'"        'Left Arrow Key
            .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 TabOrder(ByVal Direction As XlSearchDirection)
'  Ver 2 2014
 ' Authors Dave Timms (aka DMT32) and  Jerry Sullivan MVP


    Dim m As Variant, i As Long


    On Error Resume Next
    m = Application.Match(ActiveCell.Address(0, 0), TabOrderArray, 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
        i = LBound(TabOrderArray)
    Else
'get corresponding array index
        i = m + LBound(TabOrderArray) - 1
'increment i value based on tab direction
        i = i + IIf(Direction = xlPrevious, -1, xlNext)
'ensure stay within array bounds
        If i > UBound(TabOrderArray) Then i = LBound(TabOrderArray)
        If i < LBound(TabOrderArray) Then i = UBound(TabOrderArray)
    End If
    'select cell based on array element
    Application.EnableEvents = False
    Range(TabOrderArray(i)).Select
exitsub:
    Application.EnableEvents = True
End Sub


Function TabOrderArray() As Variant
       TabOrderArray = Array(“D6”, “D12”, “F12”, “J6”, “M6”, “J11”, “M11”, “M14”, “D22”, “F22”, “J21”, “J24”)
End Function

I then added the following code into 'ThisWorkbook'.
VBA Code: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOn
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = TabSheet Then SetOnkey xlOff
End Sub


Private Sub Workbook_WindowActivate(ByVal Wn As Window)
If ActiveSheet.Name = TabSheet Then SetOnkey xlOn
End Sub
 
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
SetOnkey xlOff
End Sub

When I attempt to tab through the sheet, I get the following message.
Screen Shot 2020-05-11 at 4.53.12 PM.png


I do have Macros enabled in Security settings. Any idea what I'm doing wrong or what I should change?
 
Upvote 0
Hi,
sorry I have no expertise working with files across sharepoint - maybe @Jerry Sullivan will see your post and be able to assist you with the issue.

Dave
 
Upvote 0
@dmt32 Do I at least have the correct code in the correct locations? I will trouble-shoot the SharePoint challenge. I just need to narrow down where I am.

Thank you for your help in advance.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Working with multiple Target Ranges in Worksheet Code
Replies
3
Views
754
sspatriots
S
S
  • Question Question
Worksheet Change Event
Replies
2
Views
691
sspatriots
S
G
  • Question Question
Macro Code Help for multiple worksheets.
Replies
1
Views
427
Georgiboy
Georgiboy
Lacan
  • Solved
Make VBA codes according to one specific sheet and not all entire workbook?
2
Replies
11
Views
365
Lacan
Lacan
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
1K
AndyEd
A

Forum statistics

Threads
1,223,908
Messages
6,175,307
Members
452,633
Latest member
DougMo

Share this page

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