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