This code is working but now i want if all the textboxes(Tbxs) are filled but the picturebox (Pbx1) contains no image the Msgbox to show"Now Load Photo"
If Tbx1.Text = "" Or Tbx2.Text = "" Or Tbx3.Text = "" Or Tbx4.Text = "" Or Pbx1.Image Is Nothing Then
MsgBox("Kindly Fill the Blank Cells", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly)
Exit Sub
End If
How will i do that?
Is this what you mean?
If (Tbx1.Text = "" Or Tbx2.Text = "" Or Tbx3.Text = "" Or Tbx4.Text = "") And Pbx1.Image Is Nothing Then
MsgBox("Kindly Fill the Blank Cells", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly)
Exit Sub
ElseIf CheckFilled({Tbx1, Tbx2, Tbx3, Tbx4}) And Pbx1.Image Is Nothing Then
MsgBox("Now Load Photo", MsgBoxStyle.Exclamation + MsgBoxStyle.OkOnly)
End If
Private Function CheckFilled(Tb As TextBox()) As Boolean
Dim retVal As Boolean = True
For Each t As TextBox In Tb
If t.Text.Length <= 0 Then retVal = False
Next
Return retVal
End Function
Related
I have several transactions to automate and then paste into several tables.
My code works for my first transaction but for the others I put the same code I just deleted the sheets in which I put it and it doesn't work at all.
Public SapGuiAuto, WScript, msgcol
Public objGui As GuiApplication
Public objConn As GuiConnection
Public objSess As GuiSession
Public objSBar As GuiStatusbar
Public objSheet As Worksheet
Dim W_System
Const fpath = "C:\Users\p100789\Documents\SAP\SAP GUI"
Const ffilename = "text.txt"
Sub OpenCSVFile()
'
' Load the CSV extract
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fpath & "\" & ffilename, Destination:=Range("$A$1"))
.Name = "text"
.FieldNames = True
.RowNumbers = False
[...]
End With
With ActiveSheet
.Columns(1).EntireColumn.Delete
'delete first column
.Columns(1).EntireColumn.Insert
.Rows("1:11").EntireRow.Delete 'delete first 9 rows
End With
End Sub
Function Attach_Session() As Boolean
Dim il, it
Dim W_conn, W_Sess
If W_System = "" Then
Attach_Session = False
Exit Function
End If
If Not objSess Is Nothing Then
If objSess.Info.SystemName & objSess.Info.Client = W_System Then
Attach_Session = True
Exit Function
End If
End If
If objGui Is Nothing Then
Set SapGuiAuto = GetObject("SAPGUI")
Set objGui = SapGuiAuto.GetScriptingEngine
End If
For il = 0 To objGui.Children.Count - 1
Set W_conn = objGui.Children(il + 0)
For it = 0 To W_conn.Children.Count - 1
Set W_Sess = W_conn.Children(it + 0)
If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
Set objConn = objGui.Children(il + 0)
Set objSess = objConn.Children(it + 0)
Exit For
End If
Next
Next
If objSess Is Nothing Then
MsgBox "No active session to system " + W_System + ", or scripting is not
enabled.", vbCritical + vbOKOnly
Attach_Session = False
Exit Function
End If
If IsObject(WScript) Then
WScript.ConnectObject objSess, "on"
WScript.ConnectObject objGui, "on"
End If
Set objSBar = objSess.findById("wnd[0]/sbar")
objSess.findById("wnd[0]").maximize
Attach_Session = True
End Function
Public Sub RunGUIScript()
Dim W_Ret As Boolean
Dim Société As String
Sheets("Extraction").Select
Société = Range("b9")
' Connect to SAP
W_Ret = Attach_Session
If Not W_Ret Then
Exit Sub
End If
On Error GoTo myerr
[....script]
Exit Sub
myerr:
MsgBox "Error occured while retrieving data", vbCritical + vbOKOnly
End Sub
Sub StartExtract()
' Set the sid and client to connect to
W_System = "P10320"
' Run the GUI script
RunGUIScript
' End the GUI session
objSess.EndTransaction
'effacer contenu feuille temp
Sheets("temp").Select
Cells.Select
Selection.Delete Shift:=xlUp
' Switch to the worksheet where the data is loaded to
Sheets("temp").Select
' Load the CSV file
OpenCSVFile
[...]
' Update the time and date on the control worksheet
Sheets("Extraction").Select
Cells(2, 2).Value = Now()
in short, to automate another transaction I put the same code after, by filling the script with the new script. It doesn't work, does anyone have a solution?
i currently have a problem with a simple login form in excel (VBA), when having an error, continuing and having another error it still gives me two more MsgBoxes with errors but with the "Unload Me" and "Goto Ende" it should close itself completely.
Any guesses why this isn't working? I know this is very basic and probably very redundant, but it should still work.
Public Name As Variant
Public Password As Variant
Private Sub Btn_Register_Cancel_Click()
Unload Me
End Sub
Private Sub Btn_Register_Register_Click()
Start:
Dim Error As Integer
Error = 0
Name = Tbx_Register_Name.Value
Password = Tbx_Register_Password.Value
'Check for Name, Password, Password2 if empty
If Tbx_Register_Name.Value = "" Then
Error = MsgBox("Please enter a username.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
ElseIf Tbx_Register_Password.Value = "" Then
Error = MsgBox("Please enter a password.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
ElseIf Tbx_Register_Password2.Value = "" Then
Error = MsgBox("This field cannot be empty.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
With Workbooks("General Makro.xlsx").Worksheets("User")
'Check for Username match in registration list
For i = 1 To 100
If .Cells(i, 1).Value = Name Then
Error = MsgBox("This username is already taken.", _
vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
i = 100
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
Next i
End With
'Check for the passwords to match
If Tbx_Register_Password.Value = Tbx_Register_Password2.Value Then
With Workbooks("General Makro.xlsx").Worksheets("User")
For i = 1 To 100
If .Cells(i, 1) = "" Then
.Cells(i, 1).Value = Name
.Cells(i, 2).Value = Password
Tbx_Register_Password.Value = ""
Tbx_Register_Password2.Value = ""
Application.ScreenUpdating = False
Register.Hide
Login.Show
Tbx_Login_Name.Value = .Cells(i, 1).Value
Tbx_Login_Password.Value = .Cells(i, 2).Value
Application.ScreenUpdating = True
i = 100
GoTo Ende
End If
Next i
End With
Else
Error = MsgBox("The passwords have to match!", vbRetryCancel, "Error")
If Error = 2 Then
Unload Me
GoTo Ende
Else
Application.ScreenUpdating = False
Register.Hide
Register.Show
Application.ScreenUpdating = True
GoTo Start
End If
End If
Ende:
End Sub
Edit: I Actually Tried to do the 2nd UserForm for the login, and i happen to get the same problem there. Everything works just fine, until i close the whole program, then the error-message appears again. Am i unloading the userform incorrect? Maby the login userform says open and continues when everything is getting closed.
Edit 2: I could just turn off alerts but that would be an ugly solution and definitely nothing i want to implement on every close button in the program.
You can verify blank values in textboxes with this:
If TextBox.Text = "" Then
MsgBox "Is blank!"
Unload Me
GoTo Ende
End If
'Your code
Ende: Exit Sub
To verify the username and password in a database, you can do this:
Dim sh As Worksheet
Dim LastRow As Long
Dim UserRange As Range
Dim UserMatch As Range
Set sh = ThisWorkbook.Sheets("database")
LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
Set UserRange = sh.Range("A1:A" & LastRow)
Set UserMatch = UserRange.Find(What:=UserTextBox.Text, LookIn:=xlValues)
If Not UserMatch Is Nothing Then
MsgBox "User exists!"
If PwdTextBox.Text = UserMatch.Offset(0, 1) Then
MsgBox "Pwd matched!"
'do something
Else
MsgBox "Wrong password!"
'do something
End If
Else
MsgBox "User dont exists!"
'do something
End If
This will work if in the database the usernames are in column A and the passwords in column B.
I'm trying to write VBA to run a macro if a criteria is met. The problem is that I can get it to run the first macro but then it ends!
Each macro is dependent on a true/false result in there own individual cell.
So far I have tried this:
Sub RUN_ALL_SET_SHEETS()
If Range("C28").Value = False Then
MsgBox "No Team Members Selected?"
End
ElseIf Range("C28").Value = True Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Are you sure you want to set the sheets for the Team Members selected?", vbQuestion + vbYesNo)
If Response = vbNo Then Exit Sub
Else
Return
End If
If Range("C10").Value = True Then
Call Set_Sheet_Daniel
End If
ElseIf Range("C12").Value = True Then
Call Set_Sheet_Gill
End If
ElseIf Range("C14").Value = True Then
Call Set_Sheet_Hollie
End If
ElseIf Range("C16").Value = True Then
Call Set_Sheet_Jo
ElseIf Range("C18").Value = True Then
Call Set_Sheet_Laura_H
ElseIf Range("C20").Value = True Then
Call Set_Sheet_Laura_K
ElseIf Range("C22").Value = True Then
Call Set_Sheet_Lucy
ElseIf Range("C24").Value = True Then
Call Set_Sheet_Mark
ElseIf Range("C26").Value = True Then
Call Set_Sheet_Richard
Else
End If
Sheets("Header").Select
MsgBox "Data Refreshed."
End Sub
Any help appreciated.
This should work:
Sub RUN_ALL_SET_SHEETS()
If Range("C28").Value = False Then
MsgBox "No Team Members Selected?"
End
ElseIf Range("C28").Value = True Then
Dim Response As VbMsgBoxResult
Response = MsgBox("Are you sure you want to set the sheets for the Team Members selected?", vbQuestion + vbYesNo)
' Changed single line if statement here.
' Single line if statements wont go to an else.
If Response = vbNo Then
Exit Sub
Else
Return
End If
If Range("C10").Value = True Then
Call Set_Sheet_Daniel
ElseIf Range("C12").Value = True Then
Call Set_Sheet_Gill
ElseIf Range("C14").Value = True Then
Call Set_Sheet_Hollie
ElseIf Range("C16").Value = True Then
Call Set_Sheet_Jo
ElseIf Range("C18").Value = True Then
Call Set_Sheet_Laura_H
ElseIf Range("C20").Value = True Then
Call Set_Sheet_Laura_K
ElseIf Range("C22").Value = True Then
Call Set_Sheet_Lucy
ElseIf Range("C24").Value = True Then
Call Set_Sheet_Mark
ElseIf Range("C26").Value = True Then
Call Set_Sheet_Richard
Else
End If
Sheets("Header").Select
MsgBox "Data Refreshed."
End Sub
To build off of BruceWaynes comment, this seems like something better suited for a subroutine with args. That would look something like this:
Sub Sheet_By_Name(sName as String)
' This is just a demonstration. You would have to put your code
' in this block. This also assumes the same operation is needed
' for each name.
' Checks to ensure a sheet with the supplied name exists
If Not ThisWorkbook.Sheets(sName) is Nothing Then
' Your code would replace this. It is best to avoid activate and
' select as is. Again, just for demonstration.
ThisWorkbook.Sheets(sName).Activate
Else
msgbox "A sheet with the name " & sName & " doesn't exist!"
Exit Sub
End If
End Sub
U would like to know how i can retrieve data from an excel sheet and update it in a userform.
on the picture you can see what the userform looks like.
What i would like to do is make another userform that can search for a specific reference in the sheet and update some cells of that specific row.
This is the code I have now to insert data into the sheet.
Private Sub cmdClear_Click()
' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub cmdSend_Click()
Dim RowCount As Long
Dim ctl As Control
' Check user input
If Me.combTechnieker.Value = "" Then
MsgBox "Dag vreemdeling! Welke van de 4 Mongolen ben je?", vbExclamation, "RMA invoer"
Me.combTechnieker.SetFocus
Exit Sub
End If
If Me.txtPcwRef.Value = "" Then
MsgBox "Vul onze referentie in!", vbExclamation, "RMA invoer"
Me.txtPcwRef.SetFocus
Exit Sub
End If
If Me.txtKlant.Value = "" Then
MsgBox "Vul de naam van de klant in!", vbExclamation, "RMA invoer"
Me.txtKlant.SetFocus
Exit Sub
End If
If Me.txtMerk.Value = "" Then
MsgBox "Vul het merk in!", vbExclamation, "RMA invoer"
Me.txtMerk.SetFocus
Exit Sub
End If
If Me.txtMerkRef.Value = "" Then
MsgBox "Vul de referentie van de fabrikant in!", vbExclamation, "RMA invoer"
Me.txtMerkRef.SetFocus
Exit Sub
End If
If Me.txtProduct.Value = "" Then
MsgBox "Vul het product in!", vbExclamation, "RMA invoer"
Me.txtProduct.SetFocus
Exit Sub
End If
If Me.txtSerienummer.Value = "" Then
MsgBox "Vul het serienummer in!", vbExclamation, "RMA invoer"
Me.txtSerienummer.SetFocus
Exit Sub
End If
If Me.txtProbleem.Value = "" Then
MsgBox "Vul de probleem omschrijving in!", vbExclamation, "RMA invoer"
Me.txtProbleem.SetFocus
Exit Sub
End If
If Me.txtOnderdelen.Value = "" Then
MsgBox "Bent u zeker dat er geen onderdelen achterblijven. Indien ja. Vul N/A in", vbExclamation, "RMA invoer"
Me.txtOnderdelen.SetFocus
Exit Sub
End If
' Write data to worksheet
RowCount = Worksheets("RMA 2016").Range("A1").CurrentRegion.Rows.Count
With Worksheets("RMA 2016").Range("A1")
.Offset(RowCount, 0).Value = Format(Now, "dd/mm/yyyy hh:nn:ss")
.Offset(RowCount, 1).Value = "Open"
.Offset(RowCount, 3).Value = Me.txtPcwRef.Value
.Offset(RowCount, 4).Value = Me.txtKlant.Value
.Offset(RowCount, 5).Value = Me.txtMerk.Value
.Offset(RowCount, 6).Value = Me.txtMerkRef.Value
.Offset(RowCount, 7).Value = Me.txtProduct.Value
.Offset(RowCount, 8).Value = Me.txtSerienummer.Value
.Offset(RowCount, 9).Value = Me.txtOnderdelen.Value
.Offset(RowCount, 10).Value = Me.txtProbleem.Value
.Offset(RowCount, 13).Value = Me.combTechnieker.Value
If Me.chkGarantie.Value = True Then
.Offset(RowCount, 2).Value = "Ja"
Else
.Offset(RowCount, 2).Value = "Nee"
End If
End With
' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub UserForm_Click()
End Sub
I have created a small example to showcase how the general mechanics of loading, saving and deleting a record can work together with the form. When you try to save a record with non-existing ID, it will append a new record to the table. This should be very close to what you are asking and shows you how to shuffle data between a user form and a worksheet.
Private Sub cmdLoad_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to load the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' product ID is not found
MsgBox "Product ID " & Me.txtId & " doesn't exist."
Exit Sub
Else
' product ID is found -- fill out the form
Me.txtId = rngId.Offset(0, 0)
Me.txtName = rngId.Offset(0, 1)
Me.txtNote = rngId.Offset(0, 2)
End If
End Sub
Private Sub cmdSave_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to load the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' if product ID is not found, append new one to the end of the table
With rngIdList
Set rngId = .Offset(.Rows.Count, 0).Resize(1, 1)
End With
End If
' update excel record
rngId.Offset(0, 0) = Me.txtId
rngId.Offset(0, 1) = Me.txtName
rngId.Offset(0, 2) = Me.txtNote
End Sub
Private Sub cmdDelete_Click()
' check if provided product ID is not empty
If Len(Trim(Me.txtId)) = 0 Then
MsgBox "Enter product ID to delete the record."
Exit Sub
End If
' try to retrieve the product by ID
Dim rngIdList As Range, rngId As Range
Set rngIdList = ActiveSheet.Range([a2], [a2].End(xlDown))
Set rngId = rngIdList.Find(Me.txtId, LookIn:=xlValues)
If rngId Is Nothing Then
' product ID is not found -- nothing to delete
MsgBox "Product ID " & Me.txtId & " doesn't exist."
Exit Sub
Else
' product ID is found -- delete the entire line
rngId.EntireRow.Delete
End If
End Sub
Here is a link that will explain how to do this.
http://www.onlinepclearning.com/edit-and-delete-from-a-userform/
You essentially need to record a macro using an advanced filter that filters your data based on whatever criteria you want. That data can then be used to feed a listbox in your userform using a dynamic name range where your filtered data is copied too. You can then write some code that allows it feed empty text boxes in the userform when double clicked. Then using a recorded macro that utilizes the 'find' function of excel it can find the updated entry (if it has a unique ID) and replace the old values with the new ones.
The link provided will walk through this step by step. You will just need to modify to fit in your workbook.
Hope this helps!
Example of a project I did:
'this is my recorded filter
Sub FilterData()
'
' FilterData Macro
'
'
Sheets("Propert Data").Range("A6:M80").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Sheet2!Criteria"), CopyToRange:=Range( _
"Sheet2!Extract"), Unique:=False
End Sub
'This feeds the listbox
Dim ws As Worksheet
'Set Worksheet Variable
Set ws = Sheet2
'Run Filter
FilterLoans 'this is a recorded macro
'Add named range to rowsource
If ws.Range("A5").Value = "" Then
Me.loanlist.RowSource = ""
Else
Me.loanlist.RowSource = "FilterLoans" 'this is a dynamic name range
End If
'This feeds the empty cells
Private Sub loanlist_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Integer
On Error Resume Next
i = Me.loanlist.ListIndex
Me.edloannametxt.Value = Me.loanlist.Column(0, i)
Me.edpropnametxt.Value = Me.loanlist.Column(1, i)
Me.edloantypecbx.Value = Me.loanlist.Column(2, i)
Me.edbalancetxt.Value = Me.loanlist.Column(3, i)
Me.edbalancetxt.Value = Format(Val(edbalancetxt.Value), "$#,###")
Me.edpmttxt.Value = Me.loanlist.Column(4, i)
Me.edpmttxt.Value = Format(Val(edpmttxt.Value), "$#,###")
Me.edannualtxt.Value = Me.loanlist.Column(5, i)
Me.edannualtxt.Value = Format(Val(edannualtxt.Value), "$#,###")
Me.edratetxt.Value = Me.loanlist.Column(6, i)
Me.edratetxt.Value = Format(Val(edratetxt.Value), "Percent")
Me.edamtxt.Value = Me.loanlist.Column(7, i)
Me.edbbtcbx.Value = Me.loanlist.Column(8, i)
Me.uidtxt.Value = Me.loanlist.Column(9, i)
End Sub
'this finds and updates that old data
Private Sub updateloancmd_Click()
Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet
Application.ScreenUpdating = False
Set DataSH = Sheet10
Set findvalue = DataSH.Range("K:K"). _
Find(What:=Me.uidtxt.Value, LookIn:=xlValues, LookAt:=xlWhole)
findvalue = uidtxt.Value
If findvalue = "" Then
Exit Sub
Else
findvalue.Offset(0, -1) = edbbtcbx.Value
findvalue.Offset(0, -2) = edamtxt.Value
findvalue.Offset(0, -3) = edratetxt.Value
findvalue.Offset(0, -5) = edpmttxt.Value
findvalue.Offset(0, -6) = edbalancetxt.Value
findvalue.Offset(0, -7) = edloantypecbx.Value
findvalue.Offset(0, -8) = edpropnametxt.Value
findvalue.Offset(0, -9) = edloannametxt.Value
End If
End Sub
I have 6 CheckBoxes right now under an Audience category and want to make it so that they have to select at least 1 of the 6 CheckBoxes or an error message saying "Please select an Audience" will appear.
Right now with the code below, the project will still be entered regardless of if they check one of the 6 boxes or not.
My current code looks like:
Function CheckInputs() As Boolean
If Not CheckControl(Me.nameTextbox, "Please enter your name") Then Exit Function
If Not CheckControl(Me.projectTextbox, "Please enter a Project Name") Then Exit Function
If Not CheckControl(Me.initiativeCombobox, "Please select an Initiative") Then Exit Function
If Not CheckControl(Me.impactCombobox, "Please select Impact Type") Then Exit Function
If Not CheckControl(Me.lengthListbox, "") Then If Not CheckControl(Me.lengthListbox2, "Please enter project length") Then Exit Function
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
CheckInputs = True
End Function
Private Function CountSelectedListBoxItems(lb As MSForms.ListBox) As Long
Dim i As Long
With lb
For i = 0 To .ListCount - 1
If .Selected(i) Then CountSelectedListBoxItems = CountSelectedListBoxItems + 1
Next i
End With
End Function
Function CheckControl(ctrl As MSForms.Control, errMsg As String) As Boolean
Select Case TypeName(ctrl)
Case "TextBox"
CheckControl = Trim(ctrl.Value) <> ""
Case "ComboBox"
CheckControl = ctrl.ListIndex <> -1
Case "ListBox"
CheckControl = CountSelectedListBoxItems(ctrl) > 0
Case "CheckBox"
CheckControl = ctrl.Value = False
' Case Else
End Select
If errMsg = "" Then Exit Function
If CheckControl Then Exit Function
ctrl.SetFocus
MsgBox errMsg
End Function
Would setting a CheckControl function for CheckBox as ctrl.Value = False be the appropriate route? Or did I not set my CheckInputs function correctly?
Yes, it seems to me that (if I understand correctly) your CheckInputs function is currently incorrect.
The following line of code:
If Not CheckControl(Me.rvpCheckbox, "") Then If Not CheckControl(Me.umCheckbox, "") Then If Not CheckControl(Me.uwCheckbox, "") Then If Not CheckControl(Me.baCheckbox, "") Then If Not CheckControl(Me.uaCheckbox, "") Then If Not CheckControl(Me.otherCheckbox, "Please select an Audience") Then Exit Function
needs to be change to the following:
If UserForm1.rvpCheckbox.Value = False And _
UserForm1.umCheckbox.Value = False And _
UserForm1.uwCheckbox.Value = False And _
UserForm1.baCheckbox.Value = False And _
UserForm1.uaCheckbox.Value = False And _
UserForm1.otherCheckbox.Value = False Then
UserForm1.otherCheckbox.Caption = "Please select an Audience"
'...or maybe a message box instead?
MsgBox "Please select an Audience"
Exit Function
End If