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,
In terms of the ToggleButton issue, the following works fine for the associated TextBoxes (Thanks Dave).
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.
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".
The other issue at the moment involves validating the dete inputted. Dave kindly provided the following code,
Where the Focus would be moved to the offending control via,
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.
I have attached a copy of a link to the worksheet below.
I know this is a lot to ask, but I really do appreciate any help.
Thank you
Andy
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 SubIn 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 SubHowever, 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 SubI 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 SubWhere the Focus would be moved to the offending control via,
VBA Code:
If Not InvalidDate Then InvalidDate = True: .SetFocusHowever, 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.SetFocusI have attached a copy of a link to the worksheet below.
I know this is a lot to ask, but I really do appreciate any help.
Thank you
Andy
