VBA Userform Issue - Command Button / msg Box

**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

**Andy Pope** · 01-07-2010, 11:07 AM

I can not see a reason for getting msgboxes other than if no items are selected for a particular listbox.

That said I also don't see in your code where the specific List items is obtained.

So for example if Listbox1 has the last item selected your code will output what exactly? What is lItem

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

' cut rest of code

End sub

**teeks** · 01-07-2010, 11:22 AM

(litem) was a left over from the original code.

I've now got the following code, based on your advice, it tells me ethnicity (listbox4) is not selected even when a option from the list box is Arrrghhhh!! Surprise, surprise, I can't understand why!

Any thoughts. Thanks for all your help so far!

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 Not ItemIsSelected(ListBox1) Then
        MsgBox "No Question selected"
    ElseIf Not ItemIsSelected(ListBox2) Then
        MsgBox "No Ward selected"
    ElseIf Not ItemIsSelected(ListBox3) Then
        MsgBox "No Age Band selected"
    ElseIf Not ItemIsSelected(ListBox4) Then
        MsgBox "No Ethnicity selected"
    ElseIf Not ItemIsSelected(ListBox2) Then
        MsgBox "No Gender selected"
    Else
        MsgBox "Output Selected Items"
    End If

End Sub

Private Sub Survey_Initialize()

ListBox1.List = Sheet4.Range("a65536").End(xlUp)(2, 1)
ListBox2.List = Sheet4.Range("b65536").End(xlUp)(2, 1)
ListBox3.List = Sheet4.Range("c65536").End(xlUp)(2, 1)
ListBox4.List = Sheet4.Range("d65536").End(xlUp)(2, 1)
ListBox5.List = Sheet4.Range("e65536").End(xlUp)(2, 1)

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