VBA Userform Issue - Command Button / msg Box

**teeks** · 01-07-2010, 08:19 AM

I have a command button that when I click drops the contents of numerous list boxes into excel. I wanted to add a message box to tell the user when they have not selected an item in one of the list boxes. They need to select at least one item in each list box. Example below. It is not working, even if I select an item in each list box I still get the "Please select one question!" message box displayed rather than a successful submission. I tried and if then else statement but it did the same. need it to submit the data if items selected in all list boxes, message box if not all items selected. Any help much appreciated. Code i'm trying is;

Private Sub CommandButton1_Click()

Dim lItem As Long

    For lItem = 0 To ListBox1.ListCount - 1

        If ListBox1.Selected(lItem) = True Then

            Sheet4.Range("A65536").End(xlUp)(2, 1) = ListBox1.List(lItem)
    
 End If
 
Next

Dim zItem As Long

    For zItem = 0 To ListBox1.ListCount - 1

If ListBox1.Selected(zItem) = False Then
                
MsgBox "Please select one question!" _
, vbExclamation + vbOKOnly, "Criteria not selected"

Exit Sub

End If

End Sub

**Andy Pope** · 01-07-2010, 09:42 AM

The problem is you are testing for False on selected items. But the selected property is a array of True/False elements, one for each item. So even if one is selected all the others will be false.

This examples uses a function to determine whether an item has been selected or not.

Function ItemIsSelected(Lst As msforms.ListBox) As Boolean
    Dim lngIndex As Long
    For lngIndex = 0 To Lst.ListCount - 1
        If Lst.Selected(lngIndex) Then
            ItemIsSelected = True
            Exit Function
        End If
    Next
End Function

Private Sub CommandButton1_Click()

    If ItemIsSelected(ListBox1) Then
        MsgBox "Output Items"
    Else
        MsgBox "No items selected"
    End If
    
End Sub

Private Sub UserForm_Initialize()

    ListBox1.List = Application.WorksheetFunction.Transpose(Range("A1:E1"))
    ListBox1.MultiSelect = fmMultiSelectExtended
    
End Sub

**Andy Pope** · 01-07-2010, 09:43 AM

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here

Forgot to include this. Can you edit your post please.

**teeks** · 01-07-2010, 10:29 AM

Thanks for the code, how would it look for 2 list boxes on the userform, both of which have to have an item selected and both of which are submitting data to excel at the time of user form command button click

**Andy Pope** · 01-07-2010, 10:35 AM

Thanks for the code tag edit.

You can use the same function. But we need to change the test logic.

Private Sub CommandButton1_Click()

    If not ItemIsSelected(ListBox1) Then
        MsgBox "No items selected Listbox1"
    elseif not ItemIsSelected(ListBox2) Then
        MsgBox "No items selected listbox2"
    Else
        MsgBox "Output Items for listbox1 and listbox2"
    End If

End Sub

**teeks** · 01-07-2010, 10:57 AM

I'm getting in a right pickle with this now. I thought i'd post the full messy code. I'm getting the same problem again that the message box keeps reappearing. Once a MsgBox "Please select..." appears I want to return to the user form. Bitten off far more than I can chew, thanks for the help so far Andy!!

Function ItemIsSelected(Lst As MSForms.ListBox) As Boolean
Dim IngIndex As Long
For IndIndex = 0 To Lst.ListCount - 1
    If Lst.Selected(IngIndex) Then
    ItemIsSelected = True
    Exit Function
    End If
    Next
End Function

Private Sub CommandButton1_Click()

MsgBox "The Analyser needs to calculate results based on the selected criteria. This may take a few minutes. The information bar at the bottom of the worksheet will show the calculation progress. Please be patient!" _
, vbInformation + vbOKOnly, "View Results by Selections"


If ItemIsSelected(ListBox1) Then
     
    Sheet4.Range("A65536").End(xlUp)(2, 1) = ListBox1.List(lItem)

Else
MsgBox "Please select a question", vbExclamation
Exit Sub
End If
 
If ItemIsSelected(ListBox2) Then

            Sheet4.Range("b65536").End(xlUp)(2, 1) = ListBox2.List(mItem)
Else

MsgBox "Please select one or more Ward", vbExclamation
Exit Sub
End If



If ItemIsSelected(ListBox3) Then

            Sheet4.Range("c65536").End(xlUp)(2, 1) = ListBox3.List(nItem)
Else

MsgBox "Please select one or more Age Band", vbExclamation
Exit Sub
End If



If ItemIsSelected(ListBox4) Then

            Sheet4.Range("d65536").End(xlUp)(2, 1) = ListBox4.List(oItem)
Else

MsgBox "Please select one or more Ethnicity", vbExclamation
Exit Sub
End If



If ItemIsSelected(ListBox5) Then

            Sheet4.Range("e65536").End(xlUp)(2, 1) = ListBox5.List(pItem)
Else

MsgBox "Please select one or more Gender", vbExclamation
Exit Sub
End If

Sheets("weighted2").Select
Range("a33:fh9999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("fc1:fc3"), Copytorange:=Range("A10000"), Unique:=False

Sheets("weighted2").Select
Range("a10000:fh19999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("fd1:fd9"), Copytorange:=Range("A20000"), Unique:=False

Sheets("weighted2").Select
Range("a20000:fh29999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("fe1:fe4"), Copytorange:=Range("A30000"), Unique:=False

Sheets("weighted2").Select
Range("a30000:fh39999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("ff1:ff25"), Copytorange:=Range("A40000"), Unique:=False

Sheets("weighted2").Select
Range("a40000:fh49999").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("fb1:fb3"), Copytorange:=Range("A50000"), Unique:=False

Sheets("Survey Analysis").Select
ActiveWindow.SmallScroll Down:=33
Range("A47").Select

Range("A42").Select
    Selection.Copy
    Cells.find(What:=ActiveCell, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
        
Survey.Hide

End Sub