PDA

View Full Version : Listbox selection criteria report



l7b
04-11-2011, 01:07 AM
I have 12 Listboxes
Listbox1 transfers to Listbox2
Listbox3 transfers to Listbox4
etc etc

I have used the following codes found here to help hide rows to produce a report from the selection criteria. When I am trying to run the report it tells me there is no selection even thou I have selected and transferred the criteria.

The user select a button "Report Criteria" this generates a Selection criteria Userform with the 12 listboxes.
They then select the criteria for their report transfer to the next Listbox. Then when hitting the "OK Button" this should generate the report.

It is also hiding all the rows.

Can someone please assit me.

Thanks

Private Sub CancelButton_Click()
Application.ScreenUpdating = False
Call CLEAR
Application.ScreenUpdating = True
Unload Me
Call Select_criteria
End Sub

Private Sub OKButton_Click()
Application.ScreenUpdating = False
Call Hide_Criteria
Application.ScreenUpdating = True
Unload Me
'Call Display_Selection
End Sub

Private Sub Entity_Add_Click()

Dim i As Integer

If ListBox1.ListIndex = -1 Then Exit Sub

For i = 0 To ListBox2.ListCount - 1
If ListBox1.Value = ListBox2.List(i) Then
Beep
Exit Sub
End If
Next i
ListBox2.AddItem ListBox1.Value
End Sub


Private Sub Division_Add_Click()
Dim i As Integer

If ListBox3.ListIndex = -1 Then Exit Sub

For i = 0 To ListBox4.ListCount - 1
If ListBox3.Value = ListBox4.List(i) Then
Beep

Exit Sub
End If
Next i
ListBox4.AddItem ListBox3.Value

End Sub
Private Sub Dept_Add_Click()
Dim i As Integer

If ListBox5.ListIndex = -1 Then Exit Sub

For i = 0 To ListBox6.ListCount - 1
If ListBox5.Value = ListBox6.List(i) Then
Beep
Exit Sub
End If
Next i
ListBox6.AddItem ListBox5.Value

End Sub
Private Sub BU_Add_Click()
Dim i As Integer

If ListBox7.ListIndex = -1 Then Exit Sub

For i = 0 To ListBox8.ListCount - 1
If ListBox7.Value = ListBox8.List(i) Then
Beep
Exit Sub
End If
Next i
ListBox8.AddItem ListBox7.Value


End Sub
Private Sub CC_Add_Click()
Dim i As Integer

If ListBox9.ListIndex = -1 Then Exit Sub

For i = 0 To ListBox10.ListCount - 1
If ListBox9.Value = ListBox10.List(i) Then
Beep
Exit Sub
End If
Next i
ListBox10.AddItem ListBox9.Value

End Sub
Private Sub Reporting_Add_Click()
Dim i As Integer

If Listbox11.ListIndex = -1 Then Exit Sub

For i = 0 To Listbox12.ListCount - 1
If Listbox11.Value = Listbox12.List(i) Then
Beep
Exit Sub
End If
Next i

Listbox12.AddItem Listbox11.Value

End Sub
'ENABLE ADD & REMOVE BUTTONS
Private Sub Listbox1_Enter()
Entity_Remove.Enabled = False
End Sub
Private Sub Listbox2_Enter()
Entity_Remove.Enabled = True
End Sub
Private Sub Entity_Remove_Click()
If ListBox2.ListIndex = -1 Then Exit Sub
ListBox2.RemoveItem ListBox2.ListIndex
End Sub

Private Sub Listbox3_Enter()
Division_Remove.Enabled = False
End Sub
Private Sub Listbox4_Enter()
Division_Remove.Enabled = True
End Sub
Private Sub Division_Remove_Click()
If ListBox4.ListIndex = -1 Then Exit Sub
ListBox4.RemoveItem ListBox4.ListIndex
End Sub

Private Sub Listbox5_Enter()
Dept_Remove.Enabled = False
End Sub
Private Sub Listbox6_Enter()
Dept_Removen.Enabled = True
End Sub
Private Sub Dept_Remove_Click()
If ListBox6.ListIndex = -1 Then Exit Sub
ListBox6.RemoveItem ListBox6.ListIndex
End Sub
Private Sub Listbox7_Enter()
BU_Remove.Enabled = False
End Sub
Private Sub Listbox8_Enter()
BU_Remove.Enabled = True
End Sub
Private Sub BU_Remove_Click()
If ListBox8.ListIndex = -1 Then Exit Sub
ListBox8.RemoveItem ListBox8.ListIndex
End Sub
Private Sub Listbox9_Enter()
CC_Remove.Enabled = False
End Sub
Private Sub Listbox10_Enter()
CC_Remove.Enabled = True
End Sub
Private Sub CC_Remove_Click()
If ListBox10.ListIndex = -1 Then Exit Sub
ListBox10.RemoveItem ListBox10.ListIndex
End Sub
Private Sub Listbox11_Enter()
Reporting_Remove.Enabled = False
End Sub
Private Sub Listbox12_Enter()
Reporting_Remove.Enabled = True
End Sub
Private Sub Reporting_Remove_Click()
If Listbox12.ListIndex = -1 Then Exit Sub
Listbox12.RemoveItem Listbox12.ListIndex
End Sub

Private Sub CLEAR()
Dim Cell As Range
Application.ScreenUpdating = False
Application.Calculation = False
Set HideRange = Sheets("P&L Period").Range("K17:k5000")
For Each TheCell In HideRange
Set HideRows = Rows(TheCell.Row)
If TheCell = "" Then
HideRows.EntireRow.Hidden = False
ElseIf TheCell = "ACC" Then
HideRows.EntireRow.Hidden = False
Else
HideRows.EntireRow.Hidden = False
End If
Application.ScreenUpdating = True
Application.Calculation = True

End Sub
Private Sub Hide_Criteria()
Dim lItem As Long
Dim UserRange As Range
Dim MySelection() As String
Dim NCrit As Long

Dim HideRange As Range
Dim HideRows As Range
Dim TheCell As Range

Dim HideRange1 As Range
Dim HideRows1 As Range
Dim TheCell1 As Range

Dim HideRange2 As Range
Dim HideRows2 As Range
Dim TheCell2 As Range

Dim HideRange3 As Range
Dim HideRows3 As Range
Dim TheCell3 As Range

Dim HideRange4 As Range
Dim HideRows4 As Range
Dim TheCell4 As Range

Dim HideRange5 As Range
Dim HideRows5 As Range
Dim TheCell5 As Range

Dim HideRange6 As Range
Dim HideRows6 As Range
Dim TheCell6 As Range



Application.ScreenUpdating = False
Application.Calculation = False
'----------------------------------------------------------------
'Generate a list of the selected items
Dim i As Long, msg As String, Check As String

With ListBox2
Dim i1 As Long, msg1 As String, Check1 As String

With ListBox4
Dim i2 As Long, msg2 As String, Check2 As String

With ListBox6
Dim i3 As Long, msg3 As String, Check3 As String

With ListBox8
Dim i4 As Long, msg4 As String, Check4 As String

With ListBox10
Dim i5 As Long, msg5 As String, Check5 As String

With Listbox12
Dim i6 As Long, msg6 As String, Check6 As String

'-----------------------------------------------------------------

For i = 0 To .ListCount - 1
If .Selected(i) Then
msg = msg & .List(i) & vbNewLine
End If
Next i

For i1 = 0 To .ListCount - 1
If .Selected(i1) Then
msg1 = msg1 & .List(i1) & vbNewLine
End If
Next i1

For i2 = 0 To .ListCount - 1
If .Selected(i2) Then
msg2 = msg2 & .List(i2) & vbNewLine
End If
Next i2

For i3 = 0 To .ListCount - 1
If .Selected(i3) Then
msg3 = msg3 & .List(i3) & vbNewLine
End If
Next i3

For i4 = 0 To .ListCount - 1
If .Selected(i4) Then
msg4 = msg4 & .List(i4) & vbNewLine
End If
Next i4

For i5 = 0 To .ListCount - 1
If .Selected(i5) Then
msg5 = msg5 & .List(i5) & vbNewLine
End If
Next i5

For i6 = 0 To .ListCount - 1
If .Selected(i6) Then
msg6 = msg6 & .List(i6) & vbNewLine
End If
Next i6

End With
End With
End With
End With
End With
End With
'--------------------------------------------------------------------


If msg = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check = MsgBox("You selected:" & vbNewLine & msg & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If


If msg1 = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check1 = MsgBox("You selected:" & vbNewLine & msg1 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If

If msg2 = vbNullString Then
'If nothing was selected, tell user and let them try again'
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check2 = MsgBox("You selected:" & vbNewLine & msg2 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If

If msg3 = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check3 = MsgBox("You selected:" & vbNewLine & msg3 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If

If msg4 = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check4 = MsgBox("You selected:" & vbNewLine & msg4 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If

If msg5 = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check5 = MsgBox("You selected:" & vbNewLine & msg5 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If

If msg6 = vbNullString Then
'If nothing was selected, tell user and let them try again
MsgBox "Nothing was selected! Please make a selection!"
Exit Sub
Else
'Ask the user if they are happy with their selection(s)
Check6 = MsgBox("You selected:" & vbNewLine & msg6 & vbNewLine & _
"Are you happy with your selections?", _
vbYesNo + vbInformation, "Please confirm")
End If
'-------------------------------------------------------------------------------------------
If Check = vbYes Then
If Check1 = vbYes Then
If Check2 = vbYes Then
If Check3 = vbYes Then
If Check4 = vbYes Then
If Check5 = vbYes Then
If Check6 = vbYes Then



'ENTITY
Set HideRange = Sheets("P&L Period").Range("c17:C3000")
For Each TheCell In HideRange
Set HideRows = Rows(TheCell.Row)
If TheCell = ListBox2.List(ListBox2.ListIndex) Or TheCell = "" Then
HideRows.EntireRow.Hidden = False
Else
HideRows.EntireRow.Hidden = True

End If
Next TheCell
'-------------------------------------------------------------------------------------------
'DIVISION

Set HideRange1 = Sheets("P&L Period").Range("D17:D5000")
For Each TheCell1 In HideRange1
Set HideRows1 = Rows(TheCell1.Row)
If TheCell1 = ListBox4.List(ListBox4.ListIndex) Or TheCell1 = "" Then
HideRows1.EntireRow.Hidden = False
Else
HideRows1.EntireRow.Hidden = True

End If
Next TheCell1
'-------------------------------------------------------------------------------------------
'DEPARTMENT

Set HideRange2 = Sheets("P&L Period").Range("E17:E5000")
For Each TheCell2 In HideRange2
Set HideRows2 = Rows(TheCell2.Row)
If TheCell2 = ListBox6.List(ListBox6.ListIndex) Or TheCell2 = "" Then
HideRows2.EntireRow.Hidden = False
Else
HideRows2.EntireRow.Hidden = True


End If
Next TheCell2
'-------------------------------------------------------------------------------------------
'BUSINESS UNIT

Set HideRange3 = Sheets("P&L Period").Range("F17:F5000")
For Each TheCell3 In HideRange3
Set HideRows3 = Rows(TheCell3.Row)
If TheCell3 = ListBox8.List(ListBox8.ListIndex) Or TheCell3 = "" Then
HideRows3.EntireRow.Hidden = False
Else
HideRows3.EntireRow.Hidden = True


End If
Next TheCell3
'-------------------------------------------------------------------------------------------
'COST CENTRE

Set HideRange4 = Sheets("P&L Period").Range("G17:G5000")
For Each TheCell4 In HideRange4
Set HideRows4 = Rows(TheCell4.Row)
If TheCell4 = ListBox10.List(ListBox10.ListIndex) Or TheCell4 = "" Then
HideRows4.EntireRow.Hidden = False
Else
HideRows4.EntireRow.Hidden = True


End If
Next TheCell4
'-------------------------------------------------------------------------------------------
'REPORTING UNIT

Set HideRange5 = Sheets("P&L Period").Range("I17:I5000")
For Each TheCell5 In HideRange5
Set HideRows5 = Rows(TheCell5.Row)
If TheCell5 = Listbox12.List(Listbox12.ListIndex) Or TheCell5 = "" Then
HideRows5.EntireRow.Hidden = False
Else
HideRows5.EntireRow.Hidden = True


End If
Next TheCell5
'-------------------------------------------------------------------------------------------


Set HideRange6 = Sheets("P&L Period").Range("K17:K5000")
For Each TheCell6 In HideRange6
Set HideRows6 = Rows(TheCell6.Row)
If TheCell6 = ("ACC") Or TheCell6 = "" Then
HideRows6.EntireRow.Hidden = False
Else
HideRows6.EntireRow.Hidden = True


End If
Next TheCell6
'-------------------------------------------------------------------------------------------

For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = False
Next

For i1 = 0 To ListBox4.ListCount - 1
ListBox4.Selected(i1) = False
Next

For i2 = 0 To ListBox6.ListCount - 1
ListBox6.Selected(i2) = False
Next

For i3 = 0 To ListBox8.ListCount - 1
ListBox8.Selected(i3) = False
Next

For i4 = 0 To ListBox10.ListCount - 1
ListBox10.Selected(i4) = False
Next

For i5 = 0 To Listbox12.ListCount - 1
Listbox12.Selected(i5) = False
Next
Application.ScreenUpdating = True
Application.Calculation = True

End If
End If
End If
End If
End If
End If
End If
End Sub