Mutli Use Form

DIREFULKEITH

New Member
Joined
May 1, 2019
Messages
1
I combined three forms into a mutli use form and would like help in figuring out how to modify current code to work. I would like to be able to change tab order and shade areas of form I don't need for curtain task based on wihcih command button used on menu page. Here is my current code.( some tab orders have not been chaged to reflect new forms).
module1 code
Code:
Public Function bIsTabOrderSheet(ByVal wks As Worksheet) As Boolean   Dim avSheetList As Variant
   avSheetList = Array("FORM", "FORM", "CLASS 1")
   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 "FORM"
         GetTabOrder = Array("E2", "E3", "J3", "E4", "J4", "M4", "K8", "P8", "F9", "K9", _
         "P9", "F18", "P18", "F24", "K24", "P24", "F25", "P25", "F27", "P27", _
         "F28", "K28", "F31", "K31", "P31", "F32", "K32", "P32", "F33", "K33", "P33", "F34")
                          
      Case "FORM"
         GetTabOrder = Array("E2", "E3", "J3", "E4", "J4", "M4", "K18", "P8", "F9", "K9", _
         "P9", "F11", "K11", "P11", "F12", "K12", "P12", "F13", "K13", "P13", _
         "F14", "K14", "P14", "F24", "K24", "P24", "F25", "P25", "F27", "P27", "F28", "K28", _
         "F31", "K31", "P31", "F32", "K32", "P32", "F33", "K33", "P33", "F34")
         
      Case "CLASS 1"
         GetTabOrder = Array("C2", "H2", "K2", "O2", "B3", "F3", "D6", "H6", "L6", "P6", "C8", "D8", "G8", "H8", "L8", "P8", _
          "H10", "H11", "H12", "H13", "H14", "H16", "H17", "H18", "H19", "H20", "H22", "H23", "H24", "H26", _
           "B33", "H33", "J33", "P33", "D34", "H34", "L34", "P34", _
"D36", "H36", "L36", "P38", "D37", "H37", "L37", "P37", "D38", "H38", "L38", "P38")
       
      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

menu page code (some modicication attempted but doesn't work correctly)
Code:
Private Sub CommandButton1_Click()Sheets("FORM").Visible = xlSheetVisible
Sheets("FORM").Select
End Sub


Private Sub CommandButton2_Click()
Sheets("FORM").Visible = xlSheetVisible
Sheets("FORM").Select
End Sub




Private Sub CommandButton3_Click()
Sheets("CLASS 1").Visible = xlSheetVisible
Sheets("CLASS 1").Select
End Sub


Private Sub CommandButton4_Click()
Sheets("OPC").Visible = xlSheetVisible
Sheets("OPC").Select
End Sub


Private Sub CommandButton5_Click()
Sheets("Swings").Visible = xlSheetVisible
Sheets("Swings").Select
End Sub


Private Sub CommandButton6_Click()
Sheets("Sitdown").Visible = xlSheetVisible
Sheets("Sitdown").Select
End Sub


Private Sub CommandButton7_Click()
Sheets("JLG Registration").Visible = xlSheetVisible
Sheets("JLG Registration").Select
End Sub
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Forum statistics

Threads
1,214,641
Messages
6,120,694
Members
448,979
Latest member
DET4492

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