mml
07-22-2020, 02:25 AM
Hello all
I have created a User form which is working . I need assistance with VBA code that creates an error message if any of the fields are left blank when they active the "Send "or Save"button .
Ideally for each text box or combo box that is blank .It is my hope that the blank field could be highlighted in a colour and an error message alerting that info is required and cant submit without adding text or selection
I haven't been able to find this info in the forums , possibly using incorrect terminology.
I though that I could omit this process but I have users that continually missing steps and getting agro . I think its the User they feel its my form....Anyway I would like to force Users to enter into all fields
I appreciate that my coding is not elegant but at least it is functional :yes
Hoping someone can provide guidance and education on this
Appreciation and thanks in advance
Private Sub CommandButton3_Click()Unload Me
End Sub
Private Sub CommandButton4_Click()
Dim fileName As String
fileName = "Q:SADS_ADH\ADH GPU\Electronic Interp GPU\GPU master interp.xlsm"
'Call function to check if the file is open
If IsFileOpen(fileName) = False Then
'Insert actions to be performed on the closed file
MsgBox " Masterspreadsheet is closed PLEASE PROCEED."
Else
'The file is open or another error occurred
MsgBox " Masterspreadsheet is open.PLEASE TRY AGAIN LATER."
End If
End Sub
Private Sub CommandButton6_Click()
'RESET FORM FOR NEXT REQUEST
'TextBox1.Value = ""
'TextBox2.Value = ""
TextBox3.Text = Format(Now(), "DD-MMM-YY")
ComboBox1.value = ""
TextBox6.value = ""
TextBox7.value = ""
ComboBox2.value = ""
TextBox5.value = ""
TextBox8.value = ""
TextBox9.value = ""
TextBox16.value = "60"
TextBox11.value = ""
ComboBox4.value = ""
ComboBox5.value = ""
TextBox14.value = ""
'TextBox12.Value = ""
TextBox13.value = ""
End Sub
Private Sub TextBox11_Change()
Me.TextBox11.value = Application.WorksheetFunction.Proper(Me.TextBox11.value)
End Sub
Private Sub TextBox15_Change()
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'initiate the pop up calendar with double click in this textbox
Dim datevalue As Date
datevalue = CalendarForm.GetDate
If datevalue = "12:00:00 AM" Then
'calendar was closed without picking a date
TextBox3.Text = ""
Else
'format the picked date for the textbox
TextBox3.Text = Format(datevalue, "DD-MMM-YY")
End If
End Sub
Private Sub TextBox6_Change()
Me.TextBox6.value = Application.WorksheetFunction.Proper(Me.TextBox6.value)
End Sub
Private Sub TextBox7_Change()
Me.TextBox7.value = Application.WorksheetFunction.Proper(Me.TextBox7.value)
End Sub
Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Hr = Int(Me.TextBox9 / 100)
Min = Me.TextBox9 Mod 100
Sec = 0
Me.TextBox9 = Format(TimeSerial(Hr, Min, Sec), "h:mm AM/PM")
Range("A1").value = TimeSerial(Hr, Min, Sec)
Range("A1").NumberFormat = "h:mm AM/PM"
End Sub
'Enter number for UR , format set as number
Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 46 Or KeyAscii = 32 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
MsgBox "Invalid key pressed,enter Number"
End If
End Sub
Private Sub TextBox8_Enter()
'initiate pop up calendar when entering the text box
Dim datevalue As Date
datevalue = CalendarForm.GetDate
If datevalue = "12:00:00 AM" Then
'calendar was closed without picking a date
TextBox8.Text = ""
Else
'format the picked date for the textbox
TextBox8.Text = Format(datevalue, "DD-MMM-YY")
End If
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "REQUEST"
ComboBox1.AddItem "CANCEL"
ComboBox2.AddItem "Male"
ComboBox2.AddItem "Female"
'ComboBox3.AddItem "GPU"
'ComboBox3.AddItem "SRU"
'ComboBox3.AddItem "SNU"
'ComboBox3.AddItem "OMS"
'ComboBox3.AddItem "ORTHO"
ComboBox4.AddItem "PF"
ComboBox4.AddItem "RECEP"
ComboBox5.AddItem "Miss"
ComboBox5.AddItem "Mr"
ComboBox5.AddItem "Mrs"
ComboBox5.AddItem "Ms"
ComboBox6.AddItem "Male"
ComboBox6.AddItem "Female"
ComboBox7.AddItem "A"
ComboBox7.AddItem "B"
ComboBox7.AddItem "C"
ComboBox7.AddItem "D"
ComboBox7.AddItem "E"
ComboBox7.AddItem "F"
ComboBox7.AddItem "G"
ComboBox7.AddItem "S"
ComboBox7.AddItem "ORAL DIAG"
Me.TextBox3.Text = Format(Now(), "DD-MMM-YY")
End Sub
Private Sub CommandButton1_Click()
Dim irow As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim dte
Set ws = Worksheets("Interpreter Requests")
'find first row in database TO WRITE TO
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow).value = Me.ComboBox1.Text
'to ensure real dates on sheet not text looking like dates
'dte = Split(Me.TextBox3.Text, "/")
'.Range("B" & irow).value = DateSerial(dte(2), dte(1), dte(0))
'.Range("B" & irow).NumberFormat = "DD/MM/YYYY"
.Range("B" & irow).value = Me.TextBox3.value
.Range("C" & irow).value = Me.TextBox6.Text
.Range("D" & irow).value = Me.TextBox7.Text
.Range("E" & irow).value = Me.ComboBox2.Text
.Range("F" & irow).value = Me.TextBox5.Text
'to ensure real dates on sheet not text looking like dates
'dte = Split(Me.TextBox8.Text, "/")
'.Range("G" & irow).NumberFormat = "DD/MMM/YYYY"
.Range("G" & irow).value = Me.TextBox8.value
.Range("H" & irow).value = Me.TextBox9.Text
.Range("I" & irow).value = Me.TextBox13.Text
.Range("J" & irow).value = Me.ComboBox7.Text
.Range("K" & irow).value = Me.TextBox16.Text
.Range("L" & irow).value = Me.TextBox11.Text
.Range("M" & irow).value = Me.TextBox15.Text
.Range("N" & irow).value = Me.TextBox14.Text
.Range("O" & irow).value = Me.ComboBox4.Text
End With
'RESET FORM FOR NEXT REQUEST
'TextBox1.Value = ""
'TextBox2.Value = ""
'TextBox3.Text = Format(Now(), "DD-MMM-YY")
' ComboBox1.value = ""
' TextBox6.value = ""
' TextBox7.value = ""
' ComboBox2.value = ""
' TextBox5.value = ""
' TextBox8.value = ""
'TextBox9.value = ""
' 'TextBox16.value = "60"
' TextBox11.value = ""
'ComboBox4.value = ""
'ComboBox5.value = ""
' TextBox14.value = ""
'TextBox12.Value = ""
'TextBox13.value = ""
End Sub
Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
'Change Workbook
Dim wb As Workbook
Set wb = Workbooks.Open("Q:SADS_ADH\ADH GPU\Electronic Interp GPU\GPU master interp.xlsm")
Dim emptyRow As Long
'Make Daily_Tracking_Dataset active
'nwb.Sheets("daily_tracking_dataset").Activate
'nwb.emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(wb.Sheets("GPU master Interp").Range("A:A")) + 1
'Transfer Information
With wb.Sheets("GPU master Interp")
.Cells(emptyRow, 1).value = ComboBox1.value
.Cells(emptyRow, 2).value = TextBox3.value
.Cells(emptyRow, 3).value = TextBox6.value
.Cells(emptyRow, 4).value = TextBox7.value
'.Cells(emptyRow, 6).NumberFormat = "DD-MMM-YY"
.Cells(emptyRow, 5).value = ComboBox2.value
.Cells(emptyRow, 6).value = TextBox5.value
.Cells(emptyRow, 7).value = TextBox8.value
.Cells(emptyRow, 8).value = TextBox9.value
.Cells(emptyRow, 9).value = TextBox13.value
.Cells(emptyRow, 10).value = ComboBox7.value
.Cells(emptyRow, 11).value = "60 min"
'.Cells(emptyRow, 10).value = TextBox1.value
.Cells(emptyRow, 12).value = TextBox11.value
.Cells(emptyRow, 13).value = "GPU: Level 11"
.Cells(emptyRow, 14).value = TextBox14.value
.Cells(emptyRow, 15).value = ComboBox4.value
'.Cells(emptyRow, 11).value = ComboBox6.value
'.Cells(emptyRow, 12).value = TextBox5.value
'.Cells(emptyRow, 13).value = TextBox6.value
'.Cells(emptyRow, 14).value = TextBox7.value
'.Cells(emptyRow, 15).value = ComboBox2.value
'.Cells(emptyRow, 17).value = ComboBox1.value
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
I have created a User form which is working . I need assistance with VBA code that creates an error message if any of the fields are left blank when they active the "Send "or Save"button .
Ideally for each text box or combo box that is blank .It is my hope that the blank field could be highlighted in a colour and an error message alerting that info is required and cant submit without adding text or selection
I haven't been able to find this info in the forums , possibly using incorrect terminology.
I though that I could omit this process but I have users that continually missing steps and getting agro . I think its the User they feel its my form....Anyway I would like to force Users to enter into all fields
I appreciate that my coding is not elegant but at least it is functional :yes
Hoping someone can provide guidance and education on this
Appreciation and thanks in advance
Private Sub CommandButton3_Click()Unload Me
End Sub
Private Sub CommandButton4_Click()
Dim fileName As String
fileName = "Q:SADS_ADH\ADH GPU\Electronic Interp GPU\GPU master interp.xlsm"
'Call function to check if the file is open
If IsFileOpen(fileName) = False Then
'Insert actions to be performed on the closed file
MsgBox " Masterspreadsheet is closed PLEASE PROCEED."
Else
'The file is open or another error occurred
MsgBox " Masterspreadsheet is open.PLEASE TRY AGAIN LATER."
End If
End Sub
Private Sub CommandButton6_Click()
'RESET FORM FOR NEXT REQUEST
'TextBox1.Value = ""
'TextBox2.Value = ""
TextBox3.Text = Format(Now(), "DD-MMM-YY")
ComboBox1.value = ""
TextBox6.value = ""
TextBox7.value = ""
ComboBox2.value = ""
TextBox5.value = ""
TextBox8.value = ""
TextBox9.value = ""
TextBox16.value = "60"
TextBox11.value = ""
ComboBox4.value = ""
ComboBox5.value = ""
TextBox14.value = ""
'TextBox12.Value = ""
TextBox13.value = ""
End Sub
Private Sub TextBox11_Change()
Me.TextBox11.value = Application.WorksheetFunction.Proper(Me.TextBox11.value)
End Sub
Private Sub TextBox15_Change()
End Sub
Private Sub TextBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'initiate the pop up calendar with double click in this textbox
Dim datevalue As Date
datevalue = CalendarForm.GetDate
If datevalue = "12:00:00 AM" Then
'calendar was closed without picking a date
TextBox3.Text = ""
Else
'format the picked date for the textbox
TextBox3.Text = Format(datevalue, "DD-MMM-YY")
End If
End Sub
Private Sub TextBox6_Change()
Me.TextBox6.value = Application.WorksheetFunction.Proper(Me.TextBox6.value)
End Sub
Private Sub TextBox7_Change()
Me.TextBox7.value = Application.WorksheetFunction.Proper(Me.TextBox7.value)
End Sub
Private Sub TextBox9_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Hr = Int(Me.TextBox9 / 100)
Min = Me.TextBox9 Mod 100
Sec = 0
Me.TextBox9 = Format(TimeSerial(Hr, Min, Sec), "h:mm AM/PM")
Range("A1").value = TimeSerial(Hr, Min, Sec)
Range("A1").NumberFormat = "h:mm AM/PM"
End Sub
'Enter number for UR , format set as number
Private Sub TextBox5_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 46 Or KeyAscii = 32 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
MsgBox "Invalid key pressed,enter Number"
End If
End Sub
Private Sub TextBox8_Enter()
'initiate pop up calendar when entering the text box
Dim datevalue As Date
datevalue = CalendarForm.GetDate
If datevalue = "12:00:00 AM" Then
'calendar was closed without picking a date
TextBox8.Text = ""
Else
'format the picked date for the textbox
TextBox8.Text = Format(datevalue, "DD-MMM-YY")
End If
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "REQUEST"
ComboBox1.AddItem "CANCEL"
ComboBox2.AddItem "Male"
ComboBox2.AddItem "Female"
'ComboBox3.AddItem "GPU"
'ComboBox3.AddItem "SRU"
'ComboBox3.AddItem "SNU"
'ComboBox3.AddItem "OMS"
'ComboBox3.AddItem "ORTHO"
ComboBox4.AddItem "PF"
ComboBox4.AddItem "RECEP"
ComboBox5.AddItem "Miss"
ComboBox5.AddItem "Mr"
ComboBox5.AddItem "Mrs"
ComboBox5.AddItem "Ms"
ComboBox6.AddItem "Male"
ComboBox6.AddItem "Female"
ComboBox7.AddItem "A"
ComboBox7.AddItem "B"
ComboBox7.AddItem "C"
ComboBox7.AddItem "D"
ComboBox7.AddItem "E"
ComboBox7.AddItem "F"
ComboBox7.AddItem "G"
ComboBox7.AddItem "S"
ComboBox7.AddItem "ORAL DIAG"
Me.TextBox3.Text = Format(Now(), "DD-MMM-YY")
End Sub
Private Sub CommandButton1_Click()
Dim irow As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim dte
Set ws = Worksheets("Interpreter Requests")
'find first row in database TO WRITE TO
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow).value = Me.ComboBox1.Text
'to ensure real dates on sheet not text looking like dates
'dte = Split(Me.TextBox3.Text, "/")
'.Range("B" & irow).value = DateSerial(dte(2), dte(1), dte(0))
'.Range("B" & irow).NumberFormat = "DD/MM/YYYY"
.Range("B" & irow).value = Me.TextBox3.value
.Range("C" & irow).value = Me.TextBox6.Text
.Range("D" & irow).value = Me.TextBox7.Text
.Range("E" & irow).value = Me.ComboBox2.Text
.Range("F" & irow).value = Me.TextBox5.Text
'to ensure real dates on sheet not text looking like dates
'dte = Split(Me.TextBox8.Text, "/")
'.Range("G" & irow).NumberFormat = "DD/MMM/YYYY"
.Range("G" & irow).value = Me.TextBox8.value
.Range("H" & irow).value = Me.TextBox9.Text
.Range("I" & irow).value = Me.TextBox13.Text
.Range("J" & irow).value = Me.ComboBox7.Text
.Range("K" & irow).value = Me.TextBox16.Text
.Range("L" & irow).value = Me.TextBox11.Text
.Range("M" & irow).value = Me.TextBox15.Text
.Range("N" & irow).value = Me.TextBox14.Text
.Range("O" & irow).value = Me.ComboBox4.Text
End With
'RESET FORM FOR NEXT REQUEST
'TextBox1.Value = ""
'TextBox2.Value = ""
'TextBox3.Text = Format(Now(), "DD-MMM-YY")
' ComboBox1.value = ""
' TextBox6.value = ""
' TextBox7.value = ""
' ComboBox2.value = ""
' TextBox5.value = ""
' TextBox8.value = ""
'TextBox9.value = ""
' 'TextBox16.value = "60"
' TextBox11.value = ""
'ComboBox4.value = ""
'ComboBox5.value = ""
' TextBox14.value = ""
'TextBox12.Value = ""
'TextBox13.value = ""
End Sub
Private Sub CommandButton5_Click()
Application.ScreenUpdating = False
'Change Workbook
Dim wb As Workbook
Set wb = Workbooks.Open("Q:SADS_ADH\ADH GPU\Electronic Interp GPU\GPU master interp.xlsm")
Dim emptyRow As Long
'Make Daily_Tracking_Dataset active
'nwb.Sheets("daily_tracking_dataset").Activate
'nwb.emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(wb.Sheets("GPU master Interp").Range("A:A")) + 1
'Transfer Information
With wb.Sheets("GPU master Interp")
.Cells(emptyRow, 1).value = ComboBox1.value
.Cells(emptyRow, 2).value = TextBox3.value
.Cells(emptyRow, 3).value = TextBox6.value
.Cells(emptyRow, 4).value = TextBox7.value
'.Cells(emptyRow, 6).NumberFormat = "DD-MMM-YY"
.Cells(emptyRow, 5).value = ComboBox2.value
.Cells(emptyRow, 6).value = TextBox5.value
.Cells(emptyRow, 7).value = TextBox8.value
.Cells(emptyRow, 8).value = TextBox9.value
.Cells(emptyRow, 9).value = TextBox13.value
.Cells(emptyRow, 10).value = ComboBox7.value
.Cells(emptyRow, 11).value = "60 min"
'.Cells(emptyRow, 10).value = TextBox1.value
.Cells(emptyRow, 12).value = TextBox11.value
.Cells(emptyRow, 13).value = "GPU: Level 11"
.Cells(emptyRow, 14).value = TextBox14.value
.Cells(emptyRow, 15).value = ComboBox4.value
'.Cells(emptyRow, 11).value = ComboBox6.value
'.Cells(emptyRow, 12).value = TextBox5.value
'.Cells(emptyRow, 13).value = TextBox6.value
'.Cells(emptyRow, 14).value = TextBox7.value
'.Cells(emptyRow, 15).value = ComboBox2.value
'.Cells(emptyRow, 17).value = ComboBox1.value
End With
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub