Second ListBox project ,Filter multiple table using one ListBox,VBA Teacher Sourav Bhattacharya,Kolkata

Sub setuplistbox()

Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks(ActiveWorkbook.Name).Activate
ActiveWorkbook.Sheets(2).Activate

reset

 
   
   ' Range("AJ3").Select
   ' Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
  
    'Range("AI3").Select
  '  Range(Selection, Selection.End(xlDown)).Select
   ' Selection.Copy
    'Range("AJ3").Select
    'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Application.CutCopyMode = False
    'Range("AJ3").Select
    Dim i As Integer
   
    'Dim myrange As Range
    'Range(Selection, Selection.End(xlDown)).Select
    'Set myrange = Selection
    'MsgBox (myrange.Address)
   
    'ActiveSheet.Range(myrange.Address).RemoveDuplicates Columns:=1, Header:=xlNo

    'Range("AJ3").Select
    'Range(Selection, Selection.End(xlDown)).Select
    Dim options(6) As String
   ' ReDim options(Selection.Rows.count) As String
    ' Dim cell As Object
   
    'For Each cell In Selection
     '   options(count) = cell.Value
      '  count = count + 1
       
    'Next cell

options(1) = "ODC"
options(2) = "ODW"
options(3) = "OD"
options(4) = "WB"
options(5) = "BHR"
options(6) = "JHK"



   
    'MsgBox Selection.Rows.count
   ' For count = 1 To UBound(options)
    'MsgBox (options(count))
   ' Next count
   
   
   
   ' ActiveCell.EntireColumn.Delete
   ' ActiveWorkbook.Sheets("2nd Macro").Activate
  'For i = 1 To Sheets(2).ListBox1.ListCount

               'Remove an item from the ListBox.
   '           Sheets(2).ListBox1.RemoveItem 0

    '       Next i
          
          
          
   ' Columns("B:B").Select
   ' Selection.NumberFormat = "@"
   
    'Range("B6").Select
    For i = 1 To UBound(options)
Sheets(2).ListBox1.AddItem options(i)

Next i

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


Sub dashcontrol()

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim count1 As Integer
count1 = 0

  Sheets(2).Select
    Columns("AQ:AQ").Select
    Selection.Clear
   
  Range("AQ3").Select
  ActiveCell.Value = "State"
 
  Range("AQ4").Select
   For i = 0 To Sheets(2).ListBox1.ListCount - 1
        If Sheet2.ListBox1.Selected(i) = True Then
      count1 = count1 + 1
     
     
        End If
    Next i
    If count1 = 0 Then
    Exit Sub
    Else
   
   
    For i = 0 To Sheets(2).ListBox1.ListCount - 1
        If Sheet2.ListBox1.Selected(i) = True Then
       ActiveCell.Value = Sheets(2).ListBox1.List(i)
       ActiveCell.Offset(1, 0).Select
     
        End If
    Next i

Dim filterCriteria() As String

Dim count As Integer
count = 0

Range("AQ4").Select
While ActiveCell.Value <> ""
count = count + 1
ActiveCell.Offset(1, 0).Select

Wend
'MsgBox (count)
ReDim filterCriteria(count) As String
Range("AQ4").Select

For i = 1 To count
filterCriteria(i) = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Next i

 ActiveSheet.Range("Table1").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
  ActiveSheet.Range("Table2").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
  ActiveSheet.Range("Table3").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues

  ActiveSheet.Range("Table4").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
 
  ActiveSheet.Range("Table5").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues

  ActiveSheet.Range("Table6").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
 
  ActiveSheet.Range("Table7").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues

  ActiveSheet.Range("Table8").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
 
  ActiveSheet.Range("Table9").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues

 
  ActiveSheet.Range("Table10").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
   ActiveSheet.Range("Table11").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
  
     ActiveSheet.Range("Table12").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues
   ActiveSheet.Range("Table13").AutoFilter Field:=1, Criteria1:=filterCriteria, Operator:=xlFilterValues

 Columns("AQ:AQ").Select
    Selection.Clear

End If


Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub


Sub reset()
Application.ScreenUpdating = False
Application.EnableEvents = False

Workbooks(ActiveWorkbook.Name).Activate
ActiveWorkbook.Sheets(2).Activate


    'Range("B4").Select
   

  ActiveSheet.ListObjects("Table1").Range.AutoFilter
  ActiveSheet.ListObjects("Table2").Range.AutoFilter
  ActiveSheet.ListObjects("Table3").Range.AutoFilter
  ActiveSheet.ListObjects("Table4").Range.AutoFilter
  ActiveSheet.ListObjects("Table5").Range.AutoFilter
  ActiveSheet.ListObjects("Table6").Range.AutoFilter
  ActiveSheet.ListObjects("Table7").Range.AutoFilter
  ActiveSheet.ListObjects("Table8").Range.AutoFilter
  ActiveSheet.ListObjects("Table9").Range.AutoFilter
  ActiveSheet.ListObjects("Table10").Range.AutoFilter
  ActiveSheet.ListObjects("Table11").Range.AutoFilter
  ActiveSheet.ListObjects("Table12").Range.AutoFilter
  ActiveSheet.ListObjects("Table13").Range.AutoFilter

Columns("AQ:AQ").Select
    Selection.Clear
 
   
   Dim TheItems As Long

    If Sheets(2).ListBox1.MultiSelect = 0 Then
        TheListbox = Null
    Else
        For TheItems = 0 To Sheets(2).ListBox1.ListCount - 1
            If Sheets(2).ListBox1.Selected(TheItems) Then Sheets(2).ListBox1.Selected(TheItems) = False
        Next
   
    End If

Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Shapes.Range(Array("ListBox1")).Select
    ActiveSheet.Shapes("ListBox1").ScaleWidth 1.15625, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("ListBox1").ScaleHeight 1.1302085156, msoFalse, _
        msoScaleFromTopLeft
End Sub