Userform data validation not fully working in VBA

J

JBordens

New Member
Joined
Jan 16, 2020
Messages
6
Office Version
  1. 2016
Platform
  1. Windows
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:

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
 
Sort by date Sort by votes
VBA Code: 
'saving data from userform to excell table
Private Sub cmd_opslaan_Click()

'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
Dim thuiswerken As Boolean
thuiswerken = Me.cxb1.Value

    Select Case False
    Case weeknummer <> ""
                MsgBox ("vul het weeknummer in"), vbOKOnly + vbCritical, "Weeknummer"
                Me.cbx1.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx9)
                MsgBox ("selecteer een Business Unit"), vbOKOnly + vbCritical, "Business Unit"
                Me.lbx9.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx1)
                MsgBox ("selecteer een Business Manager"), vbOKOnly + vbCritical, "Business Manager"
                Me.lbx1.SetFocus
                Exit Sub
            Case AantalBankzitters <> ""
                MsgBox ("vul het aantal bankzitters in"), vbOKOnly + vbCritical, "Aantal Bankzitters"
                Me.txb1.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx2)
                MsgBox ("selecteer minimaal 1 IP-er"), vbOKOnly + vbCritical, "Bankzitters"
                Me.lbx2.SetFocus
                Exit Sub
            Case AantalIPinDienst <> ""
                MsgBox ("vul het aantal IP-ers in dienst in"), vbOKOnly + vbCritical, "Aantal IP-ers in dienst"
                Me.txb2.SetFocus
                Exit Sub
            Case TargetIPinDienst <> ""
                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 IPersGeplaatst <> ""
                MsgBox ("vul het aantal geplaatste IP-ers in"), vbOKOnly + vbCritical, "IP-ers geplaatst"
                Me.txb4.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx3)
                MsgBox ("selecteer minimaal 1 IP-er"), vbOKOnly + vbCritical, "IP-er in procedure"
                Me.lbx3.SetFocus
                Exit Sub
            Case Kandidaten1e <> ""
                MsgBox ("vul het aantal kandidaten voor een 1e gesprek in"), vbOKOnly + vbCritical, "Kandidaten 1e gesprek"
                Me.txb5.SetFocus
                Exit Sub
            Case Kandidaten2e <> ""
                MsgBox ("vul het aantal kandidaten voor een 2e gesprek in"), vbOKOnly + vbCritical, "Kandidaten 2e gesprek"
                Me.txb6.SetFocus
                Exit Sub
            Case ContractAangboden <> ""
                MsgBox ("vul het aantal aangeboden contracten in"), vbOKOnly + vbCritical, "Contract Aangeboden"
                Me.txb7.SetFocus
                Exit Sub
            Case IPBedrijfsaanvragen <> ""
                MsgBox ("vul het aantal aanvragen voor IP in"), vbOKOnly + vbCritical, "Bedrijfsaanvragen IP"
                Me.txb8.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx4)
                MsgBox ("selecteer minimaal 1 opdrachtgever"), vbOKOnly + vbCritical, "Opdrachtgever IP"
                Me.lbx4.SetFocus
                Exit Sub
            Case IPVoorgedragen <> ""
                MsgBox ("vul het aantal voorgedragen IP-ers in"), vbOKOnly + vbCritical, "Voorgedragen IP-ers"
                Me.txb9.SetFocus
                Exit Sub
            Case WSBedrijfsaanvragen <> ""
                MsgBox ("vul het aantal aanvragen voor W&S in"), vbOKOnly + vbCritical, "Bedrijfsaanvragen W&S"
                Me.txb10.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx5)
                MsgBox ("selecteer minimaal 1 opdrachtgever"), vbOKOnly + vbCritical, "Opdrachtgever WS"
                Me.lbx5.SetFocus
                Exit Sub
            Case OpdrAfspraken <> ""
                MsgBox ("vul het aantal afspraken bij opdrachtgevers in"), vbOKOnly + vbCritical, "Aantal afspraken bij opdrachtgevers"
                Me.txb11.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx6)
                MsgBox ("selecteer minimaal 1 lead"), vbOKOnly + vbCritical, "Leads op afspraak"
                Me.lbx6.SetFocus
                Exit Sub
            Case ACQAfspraak <> ""
                MsgBox ("vul een aantal afspraken acquisitie in"), vbOKOnly + vbCritical, "Afspraken Acquisitie"
                Me.txb12.SetFocus
                Exit Sub
            Case TargetAfspraken <> ""
                MsgBox ("vul de target voor het aantal afspraken in"), vbOKOnly + vbCritical, "Target Afspraken"
                Me.txb13.SetFocus
                Exit Sub
            Case IsAnythingSelected(Me.lbx7)
                MsgBox ("selecteer minimaal 1 lead"), vbOKOnly + vbCritical, "Leads ACQ"
                Me.lbx7.SetFocus
                Exit Sub
'            Case thuiswerken = False
'                    Select Case thuiswerken
'                    Case thuiswerken = True And IsAnythingSelected(Me.lbx8)
'                        MsgBox ("selecteer minimaal 1 thuiswerkdag"), vbOKOnly + vbCritical, "Thuiswerkdagen"
'                        Me.lbx8.SetFocus
'                        Exit Sub
'                        Case Else
'                        MsgBox ("het formulier wordt nu opgeslagen"), vbOKOnly + vbInformation, "Invullen voltooid"
'                        Exit Sub
'                        End Select
'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
Call UserForm_Initialize
Me.Hide
End Sub
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
How about
Rich (BB code): 
   Case IsAnythingSelected(Me.lbx7)
      MsgBox ("selecteer minimaal 1 lead"), vbOKOnly + vbCritical, "Leads ACQ"
      Me.lbx7.SetFocus
      Exit Sub
   Case IsAnythingSelected(Me.lbx8) = False
      If Not thuiswerken Then
         MsgBox "You have selected days of but not checked the box", vbOKOnly + vbCritical
         Exit Sub
      End If
   Case IsAnythingSelected(Me.lbx8)
      If thuiswerken Then
         MsgBox ("selecteer minimaal 1 thuiswerkdag"), vbOKOnly + vbCritical, "Thuiswerkdagen"
         Me.lbx8.SetFocus
         Exit Sub
      End If
   End Select
   MsgBox ("het formulier wordt nu opgeslagen"), vbOKOnly + vbInformation, "Invullen voltooid"
'writing data from userform to excel table
   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
 
Upvote 0
You're welcome & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Inoice number not being saved in cell
Replies
6
Views
301
ipbr21054
I
I
  • Question
Changing save option from pdf to .docx advice
Replies
4
Views
543
ipbr21054
I
L
  • Question
VBA to export recurring meeting data
Replies
1
Views
584
John_w
J
I
  • Question
Excel vba to save as word doc
Replies
6
Views
662
ipbr21054
I
I
  • Solved
If Else advice to allow or forget transfer of values
Replies
7
Views
368
ipbr21054
I

Forum statistics

Threads
1,214,980
Messages
6,122,563
Members
449,088
Latest member
Motoracer88

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