Solved Multiselect listbox loop showing there isn't data (1 Viewer)

oxicottin

Learning by pecking away....
Local time
Today, 07:13
Joined
Jun 26, 2007
Messages
856
Hello im looping controls on my main from from my subform and I have one issue "So Far". I have a multi select listbox on my main form and the code below is saying there isn't data in my listbox because when ran it highlights it and there are several items selected so there are things there. What in the code below needs changed to get this working?

I did some searching and found this case for a multiselect listbox:

Case acListBox
If (ctl.MultiSelect = 0) Then


Code:
    Function VerifyMainFormData(frm As Form) As Boolean
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean

        For Each ctl In frm.Parent.Controls '  Refers to main form (frm_Main) from subform (sfrm_ProductHoldData)
            With ctl
                Select Case .ControlType
                Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                    If .Tag = "Required" Then
                        blnNoValue = False
                        If IsNull(.Value) Or Len(.Value) = 0 Then
                            blnNoValue = True
'Highlight required controls in red
                            .BorderColor = vbRed
                            .BorderWidth = 3
                            .OnEnter = "=fncResetColor()"
                        End If
                        
                        If blnNoValue Then
                            
                            strMsgName = vbNullString
                            If .Controls.Count = 1 Then
                                strMsgName = .Controls(0).Caption
                                If Right$(strMsgName, 1) = ":" Then
                                    strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                                End If
                            End If
                            If Len(strMsgName) = 0 Then
                                strMsgName = .Name
                                Select Case Left$(strMsgName, 3)
                                Case "txt", "cbo", "lst", "chk"
                                    strMsgName = Mid(strMsgName, 4)
                                End Select
                            End If
                            
                            strErrorMessage = strErrorMessage & vbCr & _
                            "   " & strMsgName
                            
                        End If
                    End If
                Case Else
'Return to origional colors
                   ' .BorderColor = 14270637
                  '  .BorderWidth = 0
                End Select
            End With
            Next ctl
            
            If Len(strErrorMessage) > 0 Then
                MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
                strErrorMessage, vbInformation, "Required Fields Are Missing"
                
                VerifyMainFormData = True
            Else
                VerifyMainFormData = False
            End If
    End Function
    
    Public Function fncResetColor()
        Dim frm As Form
        Dim ctl As Control
        Set frm = Screen.ActiveControl.Parent
        For Each ctl In frm.Controls
            With ctl
                Select Case .ControlType
                Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                    If .Tag = "Required" And .Name = Screen.ActiveControl.Name Then
                        .BorderColor = 14270637
                        .BorderWidth = 0
                        .OnEnter = ""
                        Exit For
                    End If
                End Select
            End With
        Next
    End Function
 

ebs17

Well-known member
Local time
Today, 13:13
Joined
Feb 7, 2020
Messages
1,946
Code:
frm.MultiselectListBox.Value
The return value of a list box with multiple selections is generally NULL.
Here you can only evaluate separately with VBA.
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 04:13
Joined
Aug 30, 2003
Messages
36,125
If all you want is to see if anything is selected:

If ctl.ItemsSelected.Count = 0 Then
 

oxicottin

Learning by pecking away....
Local time
Today, 07:13
Joined
Jun 26, 2007
Messages
856
Thanks @pbaldy and @arnelgp

Code:
Function VerifyMainFormData(frm As Form) As Boolean
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean
    
    For Each ctl In frm.Parent.Controls '  Refers to main form (frm_Main) from subform (sfrm_ProductHoldData)
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If .ControlType = acListBox Then
                        blnNoValue = (.ItemsSelected.Count = 0)
                        If blnNoValue Then
                            .BorderColor = vbRed
                            .BorderWidth = 3
                            .OnEnter = "=fncResetColor()"
                        End If
                        
                    Else
                        
                        If IsNull(.Value) Or Len(.Value) = 0 Then
                            blnNoValue = True
'Highlight required controls in red
                            .BorderColor = vbRed
                            .BorderWidth = 3
                            .OnEnter = "=fncResetColor()"
                        End If
                        
                    End If
                    
                    If blnNoValue Then
                        
                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If
                        
                        strErrorMessage = strErrorMessage & vbCr & _
                        "   " & strMsgName
                        
                    End If
                End If
            Case Else
'Return to origional colors
                ' .BorderColor = 14270637
               '  .BorderWidth = 0
            End Select
        End With
        Next ctl
        
        If Len(strErrorMessage) > 0 Then
            MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
            strErrorMessage, vbInformation, "Required Fields Are Missing"
            
            VerifyMainFormData = True
        Else
            VerifyMainFormData = False
        End If
    End Function

    
    Public Function fncResetColor()
        Dim frm As Form
        Dim ctl As Control
        Set frm = Screen.ActiveControl.Parent
        For Each ctl In frm.Controls
            With ctl
                Select Case .ControlType
                Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                    If .Tag = "Required" And .Name = Screen.ActiveControl.Name Then
                        .BorderColor = 14270637
                        .BorderWidth = 0
                        .OnEnter = ""
                        Exit For
                    End If
                End Select
            End With
        Next
    End Function
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 04:13
Joined
Aug 30, 2003
Messages
36,125
Happy it helped!
 

Users who are viewing this thread

Top Bottom