Sense checking UserFrom code

A

AndyEd

Board Regular
Joined
May 13, 2020
Messages
124
Office Version
  1. 365
Platform
  1. Windows
Hi all

I have attached a copy of a UserFrom, code below, which is where I am up to in terms of trying to produce something for a friend to help with their work. I have no formal training in VBA (which will become obvious) and so am cobbling this together as best I can, with invaluable help from the kind people within this forum (plus lots of head scratching and google searches).

I'm sure there will be people who will find fault in the code.

There are a couple of areas I am struggling with at the moment which revolves around the coding of a series of ToggleButtons, and Validation (checking that entries have been inputted), including setting the focus to the offending control.

There are numerous date textboxes, which are not ideal as I'd much prefer to have a date picker or similar but the machine on which this is to be used is locked by their admin, so I can't add anything externally - they've asked! Thanks to Dave for his workaround for validating the dates when manually entered.

The entire code is as follows,

VBA Code: 
Option Explicit

Private Sub UserForm_Initialize()

    Dim ctl As Control

    Workbooks("test" & ".xlsm").Worksheets("Validation sheet").Activate
  
    For Each ctl In Me.Controls
        If TypeOf ctl Is MSForms.ComboBox Then
            ctl.Clear
        End If
    Next ctl
  
    With Me
        .cbo1.List = Worksheets("Validation sheet").Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
        .cbo2.List = Worksheets("Validation sheet").Range("B2", Range("B" & Rows.Count).End(xlUp)).Value
        .cbo3.List = Worksheets("Validation sheet").Range("C2", Range("C" & Rows.Count).End(xlUp)).Value
        .cbo4.List = Worksheets("Validation sheet").Range("D2", Range("D" & Rows.Count).End(xlUp)).Value
        .cbo5.List = Worksheets("Validation sheet").Range("E2", Range("E" & Rows.Count).End(xlUp)).Value
        .cbo6.List = Worksheets("Validation sheet").Range("F2", Range("F" & Rows.Count).End(xlUp)).Value
        .cbo7.List = Worksheets("Validation sheet").Range("E2", Range("E" & Rows.Count).End(xlUp)).Value
        .cbo8.List = Worksheets("Validation sheet").Range("G2", Range("G" & Rows.Count).End(xlUp)).Value
        .cbo9.List = Worksheets("Validation sheet").Range("G2", Range("G" & Rows.Count).End(xlUp)).Value
        .cbo10.List = Worksheets("Validation sheet").Range("G2", Range("G" & Rows.Count).End(xlUp)).Value
        .cbo11.List = Worksheets("Validation sheet").Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
        .cbo12.List = Worksheets("Validation sheet").Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
        .cbo13.List = Worksheets("Validation sheet").Range("H2", Range("H" & Rows.Count).End(xlUp)).Value
    End With
  
        Dim i As Integer
            For i = 3 To 6
                Controls("opt" & i).Enabled = False
            Next i
 
    For Each ctl In Me.Controls
        If TypeOf ctl Is MSForms.ToggleButton Then
            ctl.Value = True
        End If
    Next ctl
  
    Worksheets("Tracker").Activate

    Me.MultiPage1.Value = 0
    Me.txt1.SetFocus
    
End Sub

Private Sub txt1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii
        Case 48 To 57
        Case Else
            KeyAscii = 0
    End Select

End Sub

Private Sub txt2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii
        Case 65 To 90, 97 To 122, 32
        Case Else
            KeyAscii = 0
        End Select
      
End Sub

Private Sub txt2_Change()

    Me.txt2.Text = StrConv(Me.txt2.Text, vbProperCase)
  
End Sub

Private Sub txt3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii
        Case 65 To 90, 97 To 122, 32
        Case Else
            KeyAscii = 0
        End Select
              
End Sub

Private Sub txt3_Change()

    Me.txt3.Text = UCase(Me.txt3.Text)
  
End Sub

Private Sub cbo1_Change()

    With Me
        Dim i As Integer
        Dim ctl As Control

        If .cbo1.Value = "Outcome1" Then
            For i = 8 To 11
                Controls("txt" & i).Value = vbNullString
                Controls("txt" & i).Enabled = True
            Next i

            For Each ctl In .Controls
                If TypeOf ctl Is MSForms.ToggleButton Then
                    ctl.Value = False
                End If
            Next ctl
        End If

        If .cbo1.Value <> "Outcome1" Then
            For i = 8 To 11
                Controls("txt" & i).Value = "NA"
                Controls("txt" & i).Enabled = False
            Next i
          
            For Each ctl In .Controls
                If TypeOf ctl Is MSForms.ToggleButton Then
                    ctl.Value = True
                End If
            Next ctl
        End If
    End With
      
End Sub

Private Sub cmdClear1_Click()

    With Me
        If .txt1.Value = vbNullString And .txt2.Value = vbNullString And .txt3.Value = vbNullString And _
        .cbo1.Value = vbNullString And .cbo2.Value = vbNullString And .txt4.Value = vbNullString Then
            MsgBox ("There are no values to clear."), vbInformation, "No values in fields"
            Exit Sub
        End If

        Dim Answer As Integer

        Answer = MsgBox("Are you sure you want to clear all the fields?", vbYesNo + vbQuestion, "Clear fields")
        If Answer = vbYes Then

            Dim ctl As Control
      
            For Each ctl In .Fra1.Controls
                If TypeOf ctl Is MSForms.TextBox Then
                    ctl.Value = vbNullString
                End If
            Next ctl
      
            For Each ctl In .Fra1.Controls
                If TypeOf ctl Is MSForms.ComboBox Then
                    ctl.Value = vbNullString
                End If
            Next ctl
          
            For Each ctl In .Fra3.Controls
                If TypeOf ctl Is MSForms.TextBox Then
                    ctl.Value = vbNullString
                    ctl.Enabled = True
                End If
            Next ctl
        Else
        End If
    End With
  
End Sub

Private Sub opt1_Change()

    Dim i As Integer

    With Me
        If .opt1.Value = True Then
            For i = 5 To 7
                Controls("txt" & i).Value = vbNullString
                Controls("txt" & i).Enabled = True
            Next i
          
            For i = 3 To 4
                Controls("cbo" & i).Value = vbNullString
                Controls("cbo" & i).Enabled = True
            Next i
          
            For i = 3 To 6
                Controls("opt" & i).Value = False
                Controls("opt" & i).Enabled = True
            Next i
        End If
    End With
          
End Sub

Private Sub opt2_Change()

    Dim i As Integer
  
    With Me
        If .opt2.Value = True Then
            For i = 5 To 7
                Controls("txt" & i).Value = "NA"
                Controls("txt" & i).Enabled = False
            Next i
          
            For i = 3 To 4
                Controls("cbo" & i).Value = "NA"
                Controls("cbo" & i).Enabled = False
            Next i
          
            For i = 3 To 6
                Controls("opt" & i).Value = True
                Controls("opt" & i).Enabled = False
            Next i
        End If
    End With
  
End Sub

Private Sub opt5_Change()

    With Me
        If .opt5.Value = True Then
            .cbo4.Value = vbNullString
            .cbo4.Enabled = True
            .txt7.Value = vbNullString
            .txt7.Enabled = True
        End If
    End With

End Sub

Private Sub opt6_Change()

    With Me
        If .opt6.Value = True Then
            .cbo4.Value = "NA"
            .cbo4.Enabled = False
            .txt7.Value = "NA"
            .txt7.Enabled = False
        End If
    End With

End Sub

Private Sub cbo3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii
        Case 65 To 90, 97 To 122, 32
        Case Else
            KeyAscii = 0
        End Select
              
End Sub

Private Sub cbo3_AfterUpdate()

    Me.cbo3.Text = StrConv(Me.cbo3.Text, vbProperCase)
  
End Sub

Private Sub cbo4_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii
        Case 65 To 90, 97 To 122, 32
        Case Else
            KeyAscii = 0
        End Select
              
End Sub

Private Sub cbo4_AfterUpdate()

    Me.cbo4.Text = StrConv(Me.cbo4.Text, vbProperCase)
  
End Sub

Private Sub cmdClear2_Click()

    With Me
        If .opt1.Value = False And .opt2.Value = False And .opt3.Value = False And .opt4.Value = False And _
        .opt5.Value = False And .opt6.Value = False And .txt5.Value = vbNullString And .cbo3.Value = vbNullString _
        And .txt6.Value = vbNullString And .cbo4.Value = vbNullString And .txt7.Value = vbNullString Then
      
            MsgBox ("There are no values to clear."), vbInformation, "No values in fields"
            Exit Sub
        End If

        Dim Answer As Integer

        Answer = MsgBox("Are you sure you want to clear all the fields?", vbYesNo + vbQuestion, "Clear fields")
        If Answer = vbYes Then
      
            Dim ctl As Control
            Dim i As Integer
      
            For Each ctl In .Fra2.Controls
                If TypeOf ctl Is MSForms.TextBox Then
                    ctl.Value = vbNullString
                    ctl.Enabled = True
                End If
            Next ctl
      
            For Each ctl In .Fra2.Controls
                If TypeOf ctl Is MSForms.ComboBox Then
                    ctl.Value = vbNullString
                    ctl.Enabled = True
                End If
            Next ctl
      
            For Each ctl In .Fra2.Controls
                If TypeOf ctl Is MSForms.OptionButton Then
                    ctl.Value = False
                End If
            Next ctl
          
            For i = 3 To 6
                Controls("opt" & i).Enabled = False
            Next i
        Else
        End If
    End With
  
End Sub

Private Sub cmdClear3_Click()
  
    With Me
        If .txt8.Value = "NA" Then
            MsgBox ("This not Outcome1. You cannot clear the values."), vbInformation, "Not Outcome1"
            Exit Sub
        End If
  
        If .txt8.Value = vbNullString And .txt9.Value = vbNullString And .txt10.Value = vbNullString Then
            MsgBox ("There are no values to clear."), vbInformation, "No values in fields"
            Exit Sub
        End If

        Dim Answer As Integer
  
        Answer = MsgBox("Are you sure you want to clear all the fields?", vbYesNo + vbQuestion, "Clear fields")
        If Answer = vbYes Then

            Dim ctl As Control
      
            For Each ctl In .Fra3.Controls
                If TypeOf ctl Is MSForms.TextBox Then
                    ctl.Value = vbNullString
                End If
            Next ctl
        Else
        End If
    End With
  
End Sub

Private Sub cbo5_Change()

    Me.cbo5.Text = UCase(Me.cbo5.Text)
  
End Sub

Private Sub cbo7_Change()

    Me.cbo7.Text = UCase(Me.cbo7.Text)
  
End Sub

Sub SetControls(ByVal tog As MSForms.ToggleButton, ByVal FromNum As Long, ByVal ToNum As Long)
  
    Dim Form As Object
    Dim i As Long

    Set Form = tog.Parent
  
            tog.BackColor = IIf(tog.Value, vbGreen, vbRed)
            For i = FromNum To ToNum
                With Form.Controls("txt" & i)
                    .Value = IIf(tog.Value, vbNullString, "NA")
                    .Enabled = tog.Value
                End With
            Next i
          
End Sub

Private Sub tog1_Click()

    SetControls Me.tog1, 12, 14
  
End Sub

Private Sub tog2_Click()

    SetControls Me.tog2, 15, 17
  
End Sub

Private Sub tog3_Click()

    SetControls Me.tog3, 18, 20
  
End Sub

Private Sub tog4_Click()

    SetControls Me.tog4, 21, 23
  
End Sub

Private Sub tog5_Click()

    SetControls Me.tog5, 24, 29
    If Me.tog5.Value = False Then
        Me.cbo5.Value = "NA"
        Me.cbo5.Enabled = False
    Else
        Me.cbo5.Value = vbNullString
        Me.cbo5.Enabled = True
    End If
  
End Sub

Private Sub tog6_Click()

    SetControls Me.tog6, 30, 32
  
    If Me.tog6.Value = False Then
        Me.cbo6.Value = "NA"
        Me.cbo6.Enabled = False
    Else
        Me.cbo6.Value = vbNullString
        Me.cbo6.Enabled = True
    End If
  
End Sub


Private Sub tog7_Click()

    SetControls Me.tog7, 33, 35

    If Me.tog7.Value = False Then
        Me.cbo7.Value = "NA"
        Me.cbo7.Enabled = False
    Else
        Me.cbo7.Value = vbNullString
        Me.cbo7.Enabled = True
    End If
  
End Sub

Private Sub tog8_Click()

    SetControls Me.tog8, 36, 38

    If Me.tog8.Value = False Then
        Me.cbo8.Value = "NA"
        Me.cbo8.Enabled = False
    Else
        Me.cbo8.Value = vbNullString
        Me.cbo8.Enabled = True
    End If
  
End Sub

Private Sub tog9_Click()

    SetControls Me.tog9, 39, 41

    If Me.tog9.Value = False Then
        Me.cbo9.Value = "NA"
        Me.cbo9.Enabled = False
    Else
        Me.cbo9.Value = vbNullString
        Me.cbo9.Enabled = True
    End If
  
End Sub

Private Sub tog10_Click()

    SetControls Me.tog10, 42, 44

    If Me.tog10.Value = False Then
        Me.cbo10.Value = "NA"
        Me.cbo10.Enabled = False
    Else
        Me.cbo10.Value = vbNullString
        Me.cbo10.Enabled = True
    End If
  
End Sub

Private Sub tog11_Click()

    SetControls Me.tog11, 45, 47

    If Me.tog11.Value = False Then
        Me.cbo11.Value = "NA"
        Me.cbo11.Enabled = False
    Else
        Me.cbo11.Value = vbNullString
        Me.cbo11.Enabled = True
    End If
  
End Sub

Private Sub tog12_Click()

    SetControls Me.tog12, 48, 50

    If Me.tog12.Value = False Then
        Me.cbo12.Value = "NA"
        Me.cbo12.Enabled = False
    Else
        Me.cbo12.Value = vbNullString
        Me.cbo12.Enabled = True
    End If
  
End Sub

Private Sub tog13_Click()

    SetControls Me.tog13, 51, 53

    If Me.tog13.Value = False Then
        Me.cbo13.Value = "NA"
        Me.cbo13.Enabled = False
    Else
        Me.cbo13.Value = vbNullString
        Me.cbo13.Enabled = True
    End If
  
End Sub

Function IsValidDateEntry(ByVal Form As Object, ParamArray DateTextBoxes() As Variant) As Boolean

    Dim DateBox As Variant
    Dim InvalidDate As Boolean
      
    Const RequiredFormat As String = "dd/mm/yy"
      
    With Form
        For Each DateBox In DateTextBoxes
            With DateBox
                If IsDate(.Value) Then
                    .Value = Format(DateValue(.Value), RequiredFormat)
                    .BackColor = vbWhite
                Else
                    If Len(.Value) > 0 And .Value <> "NA" Then
                        .BackColor = RGB(255, 242, 204)
                        If Not InvalidDate Then InvalidDate = True
                        Else
                            .BackColor = vbWhite
                        End If
                    End If
            End With
        Next DateBox
    End With
      
    If InvalidDate Then MsgBox "Please enter valid date(s).", vbOKOnly + vbInformation, "Invalid date entry"
      
    IsValidDateEntry = Not InvalidDate
  
End Function

Private Sub cmdSubmit_Click()

    If Not IsValidDateEntry(Me, Me.txt4, Me.txt5, Me.txt6, Me.txt7, Me.txt8, Me.txt9, Me.txt10, Me.txt11, Me.txt12, Me.txt13, Me.txt14, Me.txt15, Me.txt16, Me.txt17, _
    Me.txt18, Me.txt19, Me.txt20, Me.txt21, Me.txt22, Me.txt23, Me.txt24, Me.txt25, Me.txt26, Me.txt27, Me.txt28, Me.txt29, Me.txt30, Me.txt31, Me.txt32, Me.txt33, _
    Me.txt35, Me.txt36, Me.txt37, Me.txt38, Me.txt39, Me.txt40, Me.txt41, Me.txt42, Me.txt43, Me.txt44, Me.txt45, Me.txt46, Me.txt47, Me.txt48, Me.txt49, Me.txt50, _
    Me.txt51, Me.txt52, Me.txt53) Then Exit Sub

'   ~~ Check that controls have entries ~~

    Dim ctl As MSForms.Control
    Dim pg As MSForms.Page
    Dim bFoundOne As Boolean

    For Each pg In Me.MultiPage1.Pages
        For Each ctl In pg.Controls
            Select Case TypeName(ctl)
                Case "TextBox"
                    If ctl.Value = vbNullString Then
                        bFoundOne = True
                        FlagInvalid pg.Index, ctl
                        Exit For
                    End If
                Case "ComboBox"
                    If ctl.ListIndex = -1 Then
                        FlagInvalid pg.Index, ctl
                        bFoundOne = True
                        Exit For
                    End If

            End Select
        Next ctl
        If bFoundOne Then Exit For
        Next pg
      
End Sub
Sub FlagInvalid(lngIndex As Long, ctl As MSForms.Control)

    MsgBox "Please fill out ALL controls"
    Me.MultiPage1.Value = lngIndex
    ctl.SetFocus
  
End Sub

In terms of the ToggleButton issue, the following works fine for the associated TextBoxes (Thanks Dave).

VBA Code: 
Sub SetControls(ByVal tog As MSForms.ToggleButton, ByVal FromNum As Long, ByVal ToNum As Long)
  
    Dim Form As Object
    Dim i As Long

    Set Form = tog.Parent
  
            tog.BackColor = IIf(tog.Value, vbGreen, vbRed)
            For i = FromNum To ToNum
                With Form.Controls("txt" & i)
                    .Value = IIf(tog.Value, vbNullString, "NA")
                    .Enabled = tog.Value
                End With
            Next i
          
End Sub

However, where the ToggleButton is associated with a ComboBox I cannot get it to work and I've tried various alternatives, so have reverted to the below, for tog5 to tog13.

VBA Code: 
Private Sub tog5_Click()

    SetControls Me.tog5, 24, 29
    If Me.tog5.Value = False Then
        Me.cbo5.Value = "NA"
        Me.cbo5.Enabled = False
    Else
        Me.cbo5.Value = vbNullString
        Me.cbo5.Enabled = True
    End If
  
End Sub

I can see what the From.Control is calling for when debugging but I can't figure out how to allow for a ComboBox to be included. I'm sure it's a relatively simple solution, however every alternative I've tried results in it causing an error where it can't find the control or control references on this line, where I substitute "txt" for "cbo".

VBA Code: 
With Form.Controls("cbo" & i)

The other issue at the moment involves validating the dete inputted. Dave kindly provided the following code,

VBA Code: 
Function IsValidDateEntry(ByVal Form As Object, ParamArray DateTextBoxes() As Variant) As Boolean

    Dim DateBox As Variant
    Dim InvalidDate As Boolean
      
    Const RequiredFormat As String = "dd/mm/yy"
      
    With Form
        For Each DateBox In DateTextBoxes
            With DateBox
                If IsDate(.Value) Then
                    .Value = Format(DateValue(.Value), RequiredFormat)
                    .BackColor = vbWhite
                Else
                    If Len(.Value) > 0 And .Value <> "NA" Then
                        .BackColor = RGB(255, 242, 204)
                        If Not InvalidDate Then InvalidDate = True
                        Else
                            .BackColor = vbWhite
                        End If
                    End If
            End With
        Next DateBox
    End With
      
    If InvalidDate Then MsgBox "Please enter valid date(s).", vbOKOnly + vbInformation, "Invalid date entry"
      
    IsValidDateEntry = Not InvalidDate
  
End Function

Private Sub cmdSubmit_Click()

    If Not IsValidDateEntry(Me, Me.txt4, Me.txt5, Me.txt6, Me.txt7, Me.txt8, Me.txt9, Me.txt10, Me.txt11, Me.txt12, Me.txt13, Me.txt14, Me.txt15, Me.txt16, Me.txt17, _
    Me.txt18, Me.txt19, Me.txt20, Me.txt21, Me.txt22, Me.txt23, Me.txt24, Me.txt25, Me.txt26, Me.txt27, Me.txt28, Me.txt29, Me.txt30, Me.txt31, Me.txt32, Me.txt33, _
    Me.txt35, Me.txt36, Me.txt37, Me.txt38, Me.txt39, Me.txt40, Me.txt41, Me.txt42, Me.txt43, Me.txt44, Me.txt45, Me.txt46, Me.txt47, Me.txt48, Me.txt49, Me.txt50, _
    Me.txt51, Me.txt52, Me.txt53) Then Exit Sub

Where the Focus would be moved to the offending control via,

VBA Code: 
If Not InvalidDate Then InvalidDate = True: .SetFocus

However, as the controls are spread over a number of MultiPage pages, SetFocus causes an error.

The following validation code for blank entries appears to resolve the page navigation issue but when run it sets the focus to txt4, when txt1 is the first blank control. Additionally, There are a couple of controls that I need to allow to remain blank until that information is known, i.e. txt4, txt6, txt7, cbo4, txt10, txt11, txt14, txt17, txt20, txt23, txt26, txt27, txt28, txt29, txt32, txt35, txt, 38, txt41, txt44, txt47, txt50, txt53. Alternatively they will be populated with "NA" if they are not required via options selected within the Form prior to cmdSubmit being pressed.

VBA Code: 
    Dim ctl As MSForms.Control
    Dim pg As MSForms.Page
    Dim bFoundOne As Boolean

    For Each pg In Me.MultiPage1.Pages
        For Each ctl In pg.Controls
            Select Case TypeName(ctl)
                Case "TextBox"
                    If ctl.Value = vbNullString Then
                        bFoundOne = True
                        FlagInvalid pg.Index, ctl
                        Exit For
                    End If
                Case "ComboBox"
                    If ctl.ListIndex = -1 Then
                        FlagInvalid pg.Index, ctl
                        bFoundOne = True
                        Exit For
                    End If

            End Select
        Next ctl
        If bFoundOne Then Exit For
        Next pg
      
End Sub
Sub FlagInvalid(lngIndex As Long, ctl As MSForms.Control)

    MsgBox "Please fill out ALL controls"
    Me.MultiPage1.Value = lngIndex
    ctl.SetFocus

I have attached a copy of a link to the worksheet below.

OneDrive

Sign in to your OneDrive cloud storage and Office Online.
1drv.ms 1drv.ms

I know this is a lot to ask, but I really do appreciate any help.

Thank you

Andy
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
You must log in or register to reply here.

Similar threads

P
  • Question Question
How to VBA code to drop data from UserForm to multiple worksheets
2
Replies
17
Views
604
dmt32
D
D
  • Solved
Class Module to include one decimal place in userform textboxes
Replies
3
Views
77
dlee83
D
D
  • Solved
Numeric Value returned when Time format returned to User Form TextBox
Replies
3
Views
77
6StringJazzer
6StringJazzer
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
M
  • Question Question
What am I doing Wrong?
Replies
6
Views
260
MBarrett
M

Forum statistics

Threads
1,223,880
Messages
6,175,155
Members
452,615
Latest member
bogeys2birdies

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