I recently started coding in VBA and ran into an error / situation I'm not able to solve. I hope someone can point me in the right direction.
Here's the situation: I designed a userform in which the user is required to fill all fields presented. To make sure of that, the code validates the entry if it's either filled or not.
The issue is that for the combo and listboxes the validation doesn't work e.g. the message box does pop up.
Below is the code:
Here's the situation: I designed a userform in which the user is required to fill all fields presented. To make sure of that, the code validates the entry if it's either filled or not.
The issue is that for the combo and listboxes the validation doesn't work e.g. the message box does pop up.
Below is the code:
VBA Code:
Private Sub UserForm_Initialize()
Me.cbx1.SetFocus
'empty userform on initialization
With Me
.cbx1.Value = ""
.lbx9.Value = ""
.lbx1.Value = ""
.lbx2.Value = ""
.lbx3.Value = ""
.lbx4.Value = ""
.lbx5.Value = ""
.lbx6.Value = ""
.lbx7.Value = ""
.lbx8.Value = ""
.txb1.Value = ""
.txb2.Value = ""
.txb3.Value = ""
.txb4.Value = ""
.txb5.Value = ""
.txb6.Value = ""
.txb7.Value = ""
.txb8.Value = ""
.txb9.Value = ""
.txb10.Value = ""
.txb11.Value = ""
.txb12.Value = ""
.txb13.Value = ""
.cxb1.Value = False
End With
'make all listboxes multiple select
lbx2.MultiSelect = 1
lbx3.MultiSelect = 1
lbx4.MultiSelect = 1
lbx5.MultiSelect = 1
lbx6.MultiSelect = 1
lbx7.MultiSelect = 1
lbx8.MultiSelect = 1
'connect combobox en listboxes to data sources in sheet 'datalijsten'
Me.cbx1.List = Sheets("datalijsten").Range("a2:a54").Value
Me.lbx9.List = Sheets("datalijsten").Range("f2:F4").Value
Me.lbx1.List = Sheets("datalijsten").Range("c2:c10").Value
Me.lbx2.List = Sheets("datalijsten").Range("B2:B100").Value
Me.lbx3.List = Sheets("datalijsten").Range("B2:B100").Value
Me.lbx4.List = Sheets("datalijsten").Range("D2:D100").Value
Me.lbx5.List = Sheets("datalijsten").Range("D2:D100").Value
Me.lbx6.List = Sheets("datalijsten").Range("D2:D100").Value
Me.lbx7.List = Sheets("datalijsten").Range("D2:D100").Value
Me.lbx8.List = Sheets("datalijsten").Range("E2:E6").Value
End Sub
'make listbox "thuiswerkdagen" dependent on value checkbox "thuiswerken"
Private Sub cxb1_Click()
If Me.cxb1.Value = True Then
Me.lbx8.Enabled = True
Else
Me.lbx8.Enabled = False
End If
End Sub
'this function checks if any selection on a listbox has been made
Function IsAnythingSelected(lBox As Control) As Boolean
Dim i As Long
Dim selected As Boolean
selected = False
For i = 1 To lBox.ListCount
If lBox.selected(i) Then
selected = True
Exit For
End If
Next i
IsAnythingSelected = selected
End Function
'saving data from userform to excell table
Private Sub cmd_opslaan_Click()
Dim cbx1 As Variant
Dim lbx9 As Variant
Dim lbx1 As Variant
Dim lbx2 As Variant
Dim lbx3 As Variant
Dim lbx4 As Variant
Dim lbx5 As Variant
Dim lbx6 As Variant
Dim lbx7 As Variant
Dim lbx8 As Variant
Dim txb1 As Variant
Dim txb2 As Variant
Dim txb3 As Variant
Dim txb4 As Variant
Dim txb5 As Variant
Dim txb6 As Variant
Dim txb7 As Variant
Dim txb8 As Variant
Dim txb9 As Variant
Dim txb10 As Variant
Dim txb11 As Variant
Dim txb12 As Variant
Dim txb13 As Variant
Dim cxb1 As Boolean
'lookup first free cell
Dim lRow As Long
Dim ws As Worksheet
Dim x As Long
Set ws = Worksheets("tabelstructuur")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'validating data on userform
Dim weeknummer As Variant
weeknummer = Me.cbx1.Value
Dim businessunit As Variant
businessunit = Me.lbx9.Value
Dim businessmanager As Variant
businessmanager = Me.lbx1.Value
Dim bankzitters As Variant
bankzitters = Me.lbx2.Value
Dim WelkeIPinProcedure As Variant
WelkeIPinProcedure = Me.lbx3.Value
Dim IPBedrijven As Variant
IPBedrijven = Me.lbx4.Value
Dim WSBedrijven As Variant
WSBedrijven = Me.lbx5.Value
Dim AfspraakBedrijven As Variant
AfspraakBedrijven = Me.lbx6.Value
Dim AfspraakACQ As Variant
AfspraakACQ = Me.lbx7.Value
Dim Thuiswerkdagen As Variant
Thuiswerkdagen = Me.lbx8.Value
Dim AantalBankzitters As Variant
AantalBankzitters = Me.txb1.Value
Dim AantalIPinDienst As Variant
AantalIPinDienst = Me.txb2.Value
Dim TargetIPinDienst As Variant
TargetIPinDienst = Me.txb3.Value
Dim IPersGeplaatst As Variant
IPersGeplaatst = Me.txb4.Value
Dim Kandidaten1e As Variant
Kandidaten1e = Me.txb5.Value
Dim Kandidaten2e As Variant
Kandidaten2e = Me.txb6.Value
Dim ContractAangboden As Variant
ContractAangboden = Me.txb7.Value
Dim IPBedrijfsaanvragen As Variant
IPBedrijfsaanvragen = Me.txb8.Value
Dim IPVoorgedragen As Variant
IPVoorgedragen = Me.txb9.Value
Dim WSBedrijfsaanvragen As Variant
WSBedrijfsaanvragen = Me.txb10.Value
Dim OpdrAfspraken As Variant
OpdrAfspraken = Me.txb11.Value
Dim ACQAfspraak As Variant
ACQAfspraak = Me.txb12.Value
Dim TargetAfspraken As Variant
TargetAfspraken = Me.txb13.Value
Select Case weeknummer
Case ""
MsgBox ("vul het weeknummer in"), vbOKOnly + vbCritical, "Weeknummer"
Me.cbx1.SetFocus
Exit Sub
Case Else
Select Case businessunit
Case Not IsAnythingSelected(Me.lbx9)
MsgBox ("selecteer een Business Unit"), vbOKOnly + vbCritical, "Business Unit"
Exit Sub
Case Else
Select Case businessmanager
Case Not IsAnythingSelected(Me.lbx1)
MsgBox ("selecteer een Business Manager"), vbOKOnly + vbCritical, "Business Manager"
Exit Sub
Case Else
Select Case AantalBankzitters
Case ""
MsgBox ("vul het aantal bankzitters in"), vbOKOnly + vbCritical, "Aantal Bankzitters"
Me.txb1.SetFocus
Exit Sub
Case Else
Select Case bankzitters
Case Not IsAnythingSelected(Me.lbx2)
MsgBox ("selecteer minimaal 1 IP-er"), vbOKOnly + vbCritical, "Bankzitters"
Exit Sub
Case Else
Select Case AantalIPinDienst
Case ""
MsgBox ("vul het aantal IP-ers in dienst in"), vbOKOnly + vbCritical, "Aantal IP-ers in dienst"
Me.txb2.SetFocus
Exit Sub
Case Else
Select Case TargetIPinDienst
Case ""
MsgBox ("vul de target voor het aantal IP-ers in dienst in"), vbOKOnly + vbCritical, "Target IP-ers in dienst"
Me.txb3.SetFocus
Exit Sub
Case Else
Select Case IPersGeplaatst
Case ""
MsgBox ("vul het aantal geplaatste IP-ers in"), vbOKOnly + vbCritical, "IP-ers geplaatst"
Me.txb4.SetFocus
Exit Sub
Case Else
Select Case WelkeIPinProcedure
Case Not IsAnythingSelected(Me.lbx3)
MsgBox ("selecteer minimaal 1 IP-er"), vbOKOnly + vbCritical, "IP-er in procedure"
Exit Sub
Case Else
Select Case Kandidaten1e
Case ""
MsgBox ("vul het aantal kandidaten voor een 1e gesprek in"), vbOKOnly + vbCritical, "Kandidaten 1e gesprek"
Me.txb5.SetFocus
Exit Sub
Case Else
Select Case Kandidaten2e
Case ""
MsgBox ("vul het aantal kandidaten voor een 2e gesprek in"), vbOKOnly + vbCritical, "Kandidaten 2e gesprek"
Me.txb6.SetFocus
Exit Sub
Case Else
Select Case ContractAangboden
Case ""
MsgBox ("vul het aantal aangeboden contracten in"), vbOKOnly + vbCritical, "Contract Aangeboden"
Me.txb7.SetFocus
Exit Sub
Case Else
Select Case IPBedrijfsaanvragen
Case ""
MsgBox ("vul het aantal aanvragen voor IP in"), vbOKOnly + vbCritical, "Bedrijfsaanvragen IP"
Me.txb8.SetFocus
Exit Sub
Case Else
Select Case IPBedrijven
Case Not IsAnythingSelected(Me.lbx4)
MsgBox ("selecteer minimaal 1 opdrachtgever"), vbOKOnly + vbCritical, "Opdrachtgever IP"
Exit Sub
Case Else
Select Case IPVoorgedragen
Case ""
MsgBox ("vul het aantal voorgedragen IP-ers in"), vbOKOnly + vbCritical, "Voorgedragen IP-ers"
Me.txb9.SetFocus
Exit Sub
Case Else
Select Case WSBedrijfsaanvragen
Case ""
MsgBox ("vul het aantal aanvragen voor W&S in"), vbOKOnly + vbCritical, "Bedrijfsaanvragen W&S"
Me.txb10.SetFocus
Exit Sub
Case Else
Select Case WSBedrijven
Case Not IsAnythingSelected(Me.lbx5)
MsgBox ("selecteer minimaal 1 opdrachtgever"), vbOKOnly + vbCritical, "Opdrachtgever WS"
Exit Sub
Case Else
Select Case OpdrAfspraken
Case ""
MsgBox ("vul het aantal afspraken bij opdrachtgevers in"), vbOKOnly + vbCritical, "Aantal afspraken bij opdrachtgevers"
Me.txb11.SetFocus
Exit Sub
Case Else
Select Case AfspraakBedrijven
Case Not IsAnythingSelected(Me.lbx6)
MsgBox ("selecteer minimaal 1 lead"), vbOKOnly + vbCritical, "Leads op afspraak"
Exit Sub
Case Else
Select Case ACQAfspraak
Case ""
MsgBox ("vul een aantal afspraken acquisitie in"), vbOKOnly + vbCritical, "Afspraken Acquisitie"
Me.txb12.SetFocus
Exit Sub
Case Else
Select Case TargetAfspraken
Case ""
MsgBox ("vul de target voor het aantal afspraken in"), vbOKOnly + vbCritical, "Target Afspraken"
Me.txb13.SetFocus
Exit Sub
Case Else
Select Case AfspraakACQ
Case Not IsAnythingSelected(Me.lbx7)
MsgBox ("selecteer minimaal 1 lead"), vbOKOnly + vbCritical, "Leads ACQ"
Exit Sub
Case Else
Select Case Thuiswerkdagen
Case Not IsAnythingSelected(Me.lbx8)
MsgBox ("selecteer minimaal 1 thuiswerkdag"), vbOKOnly + vbCritical, "Thuiswerkdagen"
Exit Sub
'writing data from userform to excel table
Case Else
ws.Cells(lRow, 1).Value = Me.cbx1.Value
ws.Cells(lRow, 2).Value = Me.lbx9.Value
ws.Cells(lRow, 3).Value = Me.lbx1.Value
ws.Cells(lRow, 4).Value = Me.txb1.Value
For x = 0 To Me.lbx2.ListCount - 1
If Me.lbx2.selected(x) = True Then
If ws.Cells(lRow, 5).Value = "" Then
ws.Cells(lRow, 5).Value = Me.lbx2.List(x)
Else
ws.Cells(lRow, 5).Value = ws.Cells(lRow, 5).Value & ", " & Me.lbx2.List(x)
End If
End If
Next x
ws.Cells(lRow, 6).Value = Me.txb2.Value
ws.Cells(lRow, 7).Value = Me.txb3.Value
ws.Cells(lRow, 8).Value = Me.txb4.Value
For x = 0 To Me.lbx3.ListCount - 1
If Me.lbx3.selected(x) = True Then
If ws.Cells(lRow, 9).Value = "" Then
ws.Cells(lRow, 9).Value = Me.lbx3.List(x)
Else
ws.Cells(lRow, 9).Value = ws.Cells(lRow, 9).Value & ", " & Me.lbx3.List(x)
End If
End If
Next x
ws.Cells(lRow, 10).Value = Me.txb5.Value
ws.Cells(lRow, 11).Value = Me.txb6.Value
ws.Cells(lRow, 12).Value = Me.txb7.Value
ws.Cells(lRow, 13).Value = Me.txb8.Value
For x = 0 To Me.lbx4.ListCount - 1
If Me.lbx4.selected(x) = True Then
If ws.Cells(lRow, 14).Value = "" Then
ws.Cells(lRow, 14).Value = Me.lbx4.List(x)
Else
ws.Cells(lRow, 14).Value = ws.Cells(lRow, 14).Value & ", " & Me.lbx4.List(x)
End If
End If
Next x
ws.Cells(lRow, 15).Value = Me.txb9.Value
ws.Cells(lRow, 16).Value = Me.txb10.Value
For x = 0 To Me.lbx5.ListCount - 1
If Me.lbx5.selected(x) = True Then
If ws.Cells(lRow, 17).Value = "" Then
ws.Cells(lRow, 17).Value = Me.lbx5.List(x)
Else
ws.Cells(lRow, 17).Value = ws.Cells(lRow, 17).Value & ", " & Me.lbx5.List(x)
End If
End If
Next x
ws.Cells(lRow, 18).Value = Me.txb11.Value
For x = 0 To Me.lbx6.ListCount - 1
If Me.lbx6.selected(x) = True Then
If ws.Cells(lRow, 19).Value = "" Then
ws.Cells(lRow, 19).Value = Me.lbx6.List(x)
Else
ws.Cells(lRow, 19).Value = ws.Cells(lRow, 19).Value & ", " & Me.lbx6.List(x)
End If
End If
Next x
ws.Cells(lRow, 20).Value = Me.txb12.Value
ws.Cells(lRow, 21).Value = Me.txb13.Value
For x = 0 To Me.lbx7.ListCount - 1
If Me.lbx7.selected(x) = True Then
If ws.Cells(lRow, 22).Value = "" Then
ws.Cells(lRow, 22).Value = Me.lbx7.List(x)
Else
ws.Cells(lRow, 22).Value = ws.Cells(lRow, 22).Value & ", " & Me.lbx7.List(x)
End If
End If
Next x
If Me.cxb1.Value = True Then
ws.Cells(lRow, 23).Value = "JA"
Else
ws.Cells(lRow, 23).Value = "NEE"
End If
For x = 0 To Me.lbx8.ListCount - 1
If Me.cxb1.Value = True Then
If Me.lbx8.selected(x) = True Then
If ws.Cells(lRow, 24).Value = "" Then
ws.Cells(lRow, 24).Value = Me.lbx8.List(x)
ElseIf Me.cxb1.Value = False Then
ws.Cells(lRow, 24).Value = ""
Else
ws.Cells(lRow, 24).Value = ws.Cells(lRow, 24).Value & ", " & Me.lbx8.List(x)
End If
End If
End If
Next x
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
End Select
Call UserForm_Initialize
Me.Hide
End Sub