Multiple Selection and Filtering Logic in VBA

Multiple Selection and Filtering Logic

Tutorial on Multiple Selection and Filtering Logic This is an excel VBA tool, this is another type of ‘Userform’ selection. Its code module is very useful in day- 2 – day reporting.

All of the VBA functions are generic in nature and can be used in other excel VBA tools and for learning purpose. Here are the screen shots of the tool  for Multiple Selection and Filtering Logic in VBA:

Multiple Selection and Filtering Logic

 

Multiple Selection and Filtering Logic

Below is the code module to develop the tool for Multiple Selection and Filtering Logic in VBA:-

Dim StrReportDirectory As String

Dim strCatFilter As String

Dim srrBrandFilter As String

Dim CategoryCount As Integer

Dim Brandcount As Integer

Dim projectcodecount As Integer

Dim Filename

Dim Lrow As Long

Dim Lcol As Long

Dim RowNo As Long

Dim ColNo As Long

Dim lastcolumn As Long

Dim ws_Report As Worksheet

Dim ws_RawData As Worksheet

Dim ws_cat As Worksheet

Dim ws_Brand As Worksheet

Dim ws_Filter As Worksheet

Dim ws_SampleData As Worksheet

Dim ws As Worksheet

Dim wb_SampleCSV As Workbook

Dim wb_add As Workbook

Dim Thiswb As Workbook

Public Sub PrepareData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_SampleData = Thiswb.Sheets("EnterSampleData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

StrReportDirectory = Thiswb.Path

ws_Report.Activate

ws_SampleData.Activate

Range("Sample_Data").Select

RowNo = ActiveCell.Row + 1

ColNo = ActiveCell.Column

Range(Cells(RowNo, ColNo), Cells(RowNo, ColNo)).Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Application.ScreenUpdating = False

Workbooks.Add

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=StrReportDirectory & "\" & "SampleData_CSV" & ".csv", FileFormat:=xlCSV

Application.DisplayAlerts = True

Set wb_add = ActiveWorkbook

wb_add.Activate

ws_SampleData.Activate

Range(Cells(RowNo, ColNo), Cells(Lrow, Lcol)).Select

Selection.Copy

wb_add.Activate

wb_add.Sheets("SampleData_CSV").Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

wb_add.Save

wb_add.Close savechanges:=True

ws_Report.Activate

Range("A1").Select

Call HideRows

MsgBox "Done!!! Sample CSV Dataset Created" & vbCrLf & "You can view the dataset stored at "& StrReportDirectory, vbInformation, "Excel VBA Test-SW"

End Sub

Public Function GetBottomRow() As Long

ActiveSheet.Select

Cells(1048576, ActiveCell.Column).Select

Selection.End(xlUp).Select

GetBottomRow = ActiveCell.Row

End Function

Public Function getlastcolumn()

ActiveWorkbook.Activate

ActiveWorkbook.ActiveSheet.Select

With ActiveSheet

lastcolumn = .Cells(ActiveCell.Row, .Columns.Count).End(xlToLeft).Column

End With

End Function

Public Sub ImportData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

'"************************************ Clearing the Old Data **********************************************************

ws_cat.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_Brand.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_RawData.Activate

Cells.Select

Selection.ClearContents

ws_Report.Activate

Range("B11:F50").Select

Selection.ClearContents

'"************************************ Clearing the Old Data **********************************************************

Filename = Application.GetOpenFilename

If Filename = False Then

MsgBox "Please select the Sample Dataset CSV File", vbCritical, "Excel VBA Test-SW"

Application.DisplayAlerts = False

ws_Report.Activate

Range("A1").Select

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Workbooks.Open Filename:=Filename

Set wb_SampleCSV = ActiveWorkbook

wb_SampleCSV.Activate

wb_SampleCSV.Sheets("SampleData_CSV").Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

wb_SampleCSV.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_RawData.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

wb_SampleCSV.Activate

Range(Cells(2, 3), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Report.Activate

Range("B11").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

ws_Report.Activate

Range("A1").Select

'********************* To prepare Category List ************************************************************

Application.ScreenUpdating = False

Application.DisplayAlerts = False

wb_SampleCSV.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_cat.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

ws_cat.Activate

Columns(1).Select

ActiveSheet.Range(Cells(1, 1), Cells(Lrow, 1)).RemoveDuplicates Columns:=1, Header:=xlNo

Range("A1").Select

Lrow = GetBottomRow

CategoryCount = Lrow - 1

Range(Cells(2, 1), Cells(Lrow, 1)).Select

Selection.Copy

Range("P2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Worksheets("Report").Shapes("Drop Down 1").ControlFormat.List = Worksheets("Category").Range("P2:P" & CategoryCount + 1).Value

'Worksheets("Report").Shapes("Drop Down 1").ControlFormat.LinkedCell = Worksheets("Category").Range("Q2").Value

Application.Calculate

'************************************************************************************************************

''''********************* To prepare Brand List ************************************************************

'

'Application.ScreenUpdating = False

'Application.DisplayAlerts = False

'

'ws_RawData.Activate

'

'Range("A1").Select

'Lrow = GetBottomRow

'

'Call getlastcolumn

'Lcol = lastcolumn

'

'ws_RawData.Activate

'Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

'Selection.Copy

'

'ws_Brand.Activate

'Range("A1").Select

'

'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False

'

'ws_Brand.Activate

'Application.Calculate

'

'

'Range(Cells(1, 16), Cells(50, 16)).Select

'Selection.Copy

'

'ws_Brand.Activate

'Range("Q1").Select

'

'Dim BrandCol As Long

'

'Range("Q1").Select

'BrandCol = ActiveCell.Column

'

'Range("Q1").Select

'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False

'

'Range("Q1").Select

'Lrow = GetBottomRow

'

'Columns(BrandCol).Select

'ActiveSheet.Range(Cells(2, BrandCol), Cells(Lrow, BrandCol)).RemoveDuplicates Columns:=1, Header:=xlNo

'

'Range("Q1").Select

'Lrow = GetBottomRow

'

'Brandcount = Lrow - 1

'Worksheets("Report").Shapes("Drop Down 2").ControlFormat.List = Worksheets("Brand").Range("Q2:Q" & Brandcount).Value

'

''''********************************************************************************************************

ws_Report.Activate

Range("A1").Select

Call HideRows

wb_SampleCSV.Close savechanges:=False

End Sub

Public Sub RefreshBrandList()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'''********************* To prepare Brand List ************************************************************

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

ws_RawData.Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

ws_RawData.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Brand.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

ws_Brand.Activate

Application.Calculate

Range(Cells(1, 16), Cells(50, 16)).Select

Selection.Copy

ws_Brand.Activate

Range("Q1").Select

Dim BrandCol As Long

Range("Q1").Select

BrandCol = ActiveCell.Column

Range("Q1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("Q1").Select

Lrow = GetBottomRow

Columns(BrandCol).Select

ActiveSheet.Range(Cells(2, BrandCol), Cells(Lrow, BrandCol)).RemoveDuplicates Columns:=1, Header:=xlNo

Range("Q1").Select

Lrow = GetBottomRow

Brandcount = Lrow - 1

Worksheets("Report").Shapes("Drop Down 2").ControlFormat.List = Worksheets("Brand").Range("Q2:Q" & Brandcount).Value

'''********************************************************************************************************

ws_Report.Activate

Range("A1").Select

Call HideRows

End Sub

Public Sub showFilteredData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

Application.Calculate

strCatFilter = Thiswb.Sheets("Category").Range("CatRange").Value

srrBrandFilter = Thiswb.Sheets("Brand").Range("BrandRange").Value

ws_Report.Activate

Range("B11:F50").Select

Selection.ClearContents

ws_Filter.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_RawData.AutoFilterMode = False

ws_RawData.Activate

Range("A1").Select

Range(Range("XFD1").End(xlToLeft), Range("A1048576").End(xlUp)).Name = "All_data"

With Range("All_data")

.AutoFilter Field:=1, Criteria1:=strCatFilter

.AutoFilter Field:=2, Criteria1:=srrBrandFilter

End With

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Filter.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("A1").Select

ws_Filter.Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Range(Cells(2, 3), Cells(Lrow, 7)).Select

Selection.Copy

ws_Report.Activate

Range("B11").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

Application.Calculate

ws_Report.Activate

Range("A1").Select

Application.Calculate

ws_RawData.AutoFilterMode = False

ws_Report.Activate

Range("A1").Select

Range("G1").Value = 1

Application.Calculate

Call HideRows

End Sub

Public Sub UnHideRows()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Rows("17:50").EntireRow.Hidden = False

Range("A:F").EntireColumn.Hidden = False

End Sub

Public Sub HideRows()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Rows("17:50").EntireRow.Hidden = True

Range("A:F").EntireColumn.Hidden = True

End Sub

Public Sub PopulateProjectCode()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Call UnHideRows

Application.Calculate

'********************** Populate list for project code ********************************

ws_Filter.Activate

Range("C1").Select

Lrow = GetBottomRow

projectcodecount = Lrow

If projectcodecount = 2 Then

Worksheets("Report").Shapes("Drop Down 13").ControlFormat.List = Worksheets("FilteredData").Range("C2:C5").Value

Else

Worksheets("Report").Shapes("Drop Down 13").ControlFormat.List = Worksheets("FilteredData").Range("C2:C" & projectcodecount).Value

End If

'*****************************************************************************************

Application.Calculate

Call HideRows

End Sub

Public Sub ExportData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Call UnHideWorkbooks

StrReportDirectory = Thiswb.Path

Application.ScreenUpdating = False

Application.DisplayAlerts = False

ws_Filter.Activate

Range("A1").Select

Workbooks.Add

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs StrReportDirectory & "\" & "Export_SampleData" & ".xlsx", FileFormat _

:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _

False, CreateBackup:=False

Application.DisplayAlerts = True

Set wb_add = ActiveWorkbook

wb_add.Activate

ws_Filter.Activate

Range("A1").Select

Lrow = GetBottomRow

Range(Cells(1, 1), Cells(Lrow, 7)).Select

Selection.Copy

wb_add.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

Application.Calculate

wb_add.Save

ws_Report.Activate

Range("A1").Select

Application.Calculate

MsgBox "Done!!! Sample Dataset Exported" & vbCrLf & "You can view the dataset stored at "& StrReportDirectory, vbInformation, "Excel VBA Test-SW"

End Sub

Public Sub UnHideWorkbooks()

Application.ScreenUpdating = False

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

For Each ws In Thiswb.Worksheets

If ws.Name = "RawData" Or ws.Name = "Category" Or ws.Name = "Brand" Or ws.Name = "FilteredData" Then

Thiswb.Sheets(ws.Name).Visible = True

End If

Next

ws_Report.Activate

Range("A1").Select

End Sub

Public Sub HideWorkbooks()

Application.ScreenUpdating = False

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

For Each ws In Thiswb.Worksheets

If ws.Name = "RawData" Or ws.Name = "Category" Or ws.Name = "Brand" Or ws.Name = "FilteredData" Then

Thiswb.Sheets(ws.Name).Visible = False

End If

Next

ws_Report.Activate

Range("A1").Select

End Sub

Public Sub NextTab()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Range("A1").Select

End Sub

Dim StrReportDirectory As String

Dim strCatFilter As String

Dim srrBrandFilter As String

Dim CategoryCount As Integer

Dim Brandcount As Integer

Dim projectcodecount As Integer

Dim Filename

Dim Lrow As Long

Dim Lcol As Long

Dim RowNo As Long

Dim ColNo As Long

Dim lastcolumn As Long

Dim ws_Report As Worksheet

Dim ws_RawData As Worksheet

Dim ws_cat As Worksheet

Dim ws_Brand As Worksheet

Dim ws_Filter As Worksheet

Dim ws_SampleData As Worksheet

Dim ws As Worksheet

Dim wb_SampleCSV As Workbook

Dim wb_add As Workbook

Dim Thiswb As Workbook

Public Sub PrepareData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_SampleData = Thiswb.Sheets("EnterSampleData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

StrReportDirectory = Thiswb.Path

ws_Report.Activate

ws_SampleData.Activate

Range("Sample_Data").Select

RowNo = ActiveCell.Row + 1

ColNo = ActiveCell.Column

Range(Cells(RowNo, ColNo), Cells(RowNo, ColNo)).Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Application.ScreenUpdating = False

Workbooks.Add

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:=StrReportDirectory & "\" & "SampleData_CSV" & ".csv", FileFormat:=xlCSV

Application.DisplayAlerts = True

Set wb_add = ActiveWorkbook

wb_add.Activate

ws_SampleData.Activate

Range(Cells(RowNo, ColNo), Cells(Lrow, Lcol)).Select

Selection.Copy

wb_add.Activate

wb_add.Sheets("SampleData_CSV").Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

wb_add.Save

wb_add.Close savechanges:=True

ws_Report.Activate

Range("A1").Select

Call HideRows

MsgBox "Done!!! Sample CSV Dataset Created" & vbCrLf & "You can view the dataset stored at "& StrReportDirectory, vbInformation, "Excel VBA Test-SW"

End Sub

Public Function GetBottomRow() As Long

ActiveSheet.Select

Cells(1048576, ActiveCell.Column).Select

Selection.End(xlUp).Select

GetBottomRow = ActiveCell.Row

End Function

Public Function getlastcolumn()

ActiveWorkbook.Activate

ActiveWorkbook.ActiveSheet.Select

With ActiveSheet

lastcolumn = .Cells(ActiveCell.Row, .Columns.Count).End(xlToLeft).Column

End With

End Function

Public Sub ImportData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

'"************************************ Clearing the Old Data **********************************************************

ws_cat.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_Brand.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_RawData.Activate

Cells.Select

Selection.ClearContents

ws_Report.Activate

Range("B11:F50").Select

Selection.ClearContents

'"************************************ Clearing the Old Data **********************************************************

Filename = Application.GetOpenFilename

If Filename = False Then

MsgBox "Please select the Sample Dataset CSV File", vbCritical, "Excel VBA Test-SW"

Application.DisplayAlerts = False

ws_Report.Activate

Range("A1").Select

End If

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Workbooks.Open Filename:=Filename

Set wb_SampleCSV = ActiveWorkbook

wb_SampleCSV.Activate

wb_SampleCSV.Sheets("SampleData_CSV").Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

wb_SampleCSV.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_RawData.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

wb_SampleCSV.Activate

Range(Cells(2, 3), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Report.Activate

Range("B11").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

ws_Report.Activate

Range("A1").Select

'********************* To prepare Category List ************************************************************

Application.ScreenUpdating = False

Application.DisplayAlerts = False

wb_SampleCSV.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_cat.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

ws_cat.Activate

Columns(1).Select

ActiveSheet.Range(Cells(1, 1), Cells(Lrow, 1)).RemoveDuplicates Columns:=1, Header:=xlNo

Range("A1").Select

Lrow = GetBottomRow

CategoryCount = Lrow - 1

Range(Cells(2, 1), Cells(Lrow, 1)).Select

Selection.Copy

Range("P2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Worksheets("Report").Shapes("Drop Down 1").ControlFormat.List = Worksheets("Category").Range("P2:P" & CategoryCount + 1).Value

'Worksheets("Report").Shapes("Drop Down 1").ControlFormat.LinkedCell = Worksheets("Category").Range("Q2").Value

Application.Calculate

'************************************************************************************************************

''''********************* To prepare Brand List ************************************************************

'

'Application.ScreenUpdating = False

'Application.DisplayAlerts = False

'

'ws_RawData.Activate

'

'Range("A1").Select

'Lrow = GetBottomRow

'

'Call getlastcolumn

'Lcol = lastcolumn

'

'ws_RawData.Activate

'Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

'Selection.Copy

'

'ws_Brand.Activate

'Range("A1").Select

'

'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False

'

'ws_Brand.Activate

'Application.Calculate

'

'

'Range(Cells(1, 16), Cells(50, 16)).Select

'Selection.Copy

'

'ws_Brand.Activate

'Range("Q1").Select

'

'Dim BrandCol As Long

'

'Range("Q1").Select

'BrandCol = ActiveCell.Column

'

'Range("Q1").Select

'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Application.CutCopyMode = False

'

'Range("Q1").Select

'Lrow = GetBottomRow

'

'Columns(BrandCol).Select

'ActiveSheet.Range(Cells(2, BrandCol), Cells(Lrow, BrandCol)).RemoveDuplicates Columns:=1, Header:=xlNo

'

'Range("Q1").Select

'Lrow = GetBottomRow

'

'Brandcount = Lrow - 1

'Worksheets("Report").Shapes("Drop Down 2").ControlFormat.List = Worksheets("Brand").Range("Q2:Q" & Brandcount).Value

'

''''********************************************************************************************************

ws_Report.Activate

Range("A1").Select

Call HideRows

wb_SampleCSV.Close savechanges:=False

End Sub

Public Sub RefreshBrandList()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'''********************* To prepare Brand List ************************************************************

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

ws_RawData.Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

ws_RawData.Activate

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Brand.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

ws_Brand.Activate

Application.Calculate

Range(Cells(1, 16), Cells(50, 16)).Select

Selection.Copy

ws_Brand.Activate

Range("Q1").Select

Dim BrandCol As Long

Range("Q1").Select

BrandCol = ActiveCell.Column

Range("Q1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("Q1").Select

Lrow = GetBottomRow

Columns(BrandCol).Select

ActiveSheet.Range(Cells(2, BrandCol), Cells(Lrow, BrandCol)).RemoveDuplicates Columns:=1, Header:=xlNo

Range("Q1").Select

Lrow = GetBottomRow

Brandcount = Lrow - 1

Worksheets("Report").Shapes("Drop Down 2").ControlFormat.List = Worksheets("Brand").Range("Q2:Q" & Brandcount).Value

'''********************************************************************************************************

ws_Report.Activate

Range("A1").Select

Call HideRows

End Sub

Public Sub showFilteredData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Call UnHideWorkbooks

Call UnHideRows

Application.Calculate

strCatFilter = Thiswb.Sheets("Category").Range("CatRange").Value

srrBrandFilter = Thiswb.Sheets("Brand").Range("BrandRange").Value

ws_Report.Activate

Range("B11:F50").Select

Selection.ClearContents

ws_Filter.Activate

Range("A1:M100").Select

Selection.ClearContents

ws_RawData.AutoFilterMode = False

ws_RawData.Activate

Range("A1").Select

Range(Range("XFD1").End(xlToLeft), Range("A1048576").End(xlUp)).Name = "All_data"

With Range("All_data")

.AutoFilter Field:=1, Criteria1:=strCatFilter

.AutoFilter Field:=2, Criteria1:=srrBrandFilter

End With

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Range(Cells(1, 1), Cells(Lrow, Lcol)).Select

Selection.Copy

ws_Filter.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Range("A1").Select

ws_Filter.Activate

Range("A1").Select

Lrow = GetBottomRow

Call getlastcolumn

Lcol = lastcolumn

Range(Cells(2, 3), Cells(Lrow, 7)).Select

Selection.Copy

ws_Report.Activate

Range("B11").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

Application.Calculate

ws_Report.Activate

Range("A1").Select

Application.Calculate

ws_RawData.AutoFilterMode = False

ws_Report.Activate

Range("A1").Select

Range("G1").Value = 1

Application.Calculate

Call HideRows

End Sub

Public Sub UnHideRows()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Rows("17:50").EntireRow.Hidden = False

Range("A:F").EntireColumn.Hidden = False

End Sub

Public Sub HideRows()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Rows("17:50").EntireRow.Hidden = True

Range("A:F").EntireColumn.Hidden = True

End Sub

Public Sub PopulateProjectCode()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_cat = Thiswb.Sheets("Category")

Set ws_Brand = Thiswb.Sheets("Brand")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Application.ScreenUpdating = False

Application.DisplayAlerts = False

'Call UnHideRows

Application.Calculate

'********************** Populate list for project code ********************************

ws_Filter.Activate

Range("C1").Select

Lrow = GetBottomRow

projectcodecount = Lrow

If projectcodecount = 2 Then

Worksheets("Report").Shapes("Drop Down 13").ControlFormat.List = Worksheets("FilteredData").Range("C2:C5").Value

Else

Worksheets("Report").Shapes("Drop Down 13").ControlFormat.List = Worksheets("FilteredData").Range("C2:C" & projectcodecount).Value

End If

'*****************************************************************************************

Application.Calculate

Call HideRows

End Sub

Public Sub ExportData()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

Set ws_RawData = Thiswb.Sheets("RawData")

Set ws_Filter = Thiswb.Sheets("FilteredData")

Call UnHideWorkbooks

StrReportDirectory = Thiswb.Path

Application.ScreenUpdating = False

Application.DisplayAlerts = False

ws_Filter.Activate

Range("A1").Select

Workbooks.Add

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs StrReportDirectory & "\" & "Export_SampleData" & ".xlsx", FileFormat _

:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _

False, CreateBackup:=False

Application.DisplayAlerts = True

Set wb_add = ActiveWorkbook

wb_add.Activate

ws_Filter.Activate

Range("A1").Select

Lrow = GetBottomRow

Range(Cells(1, 1), Cells(Lrow, 7)).Select

Selection.Copy

wb_add.Activate

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Application.DisplayAlerts = False

Application.Calculate

wb_add.Save

ws_Report.Activate

Range("A1").Select

Application.Calculate

MsgBox "Done!!! Sample Dataset Exported" & vbCrLf & "You can view the dataset stored at "& StrReportDirectory, vbInformation, "Excel VBA Test-SW"

End Sub

Public Sub UnHideWorkbooks()

Application.ScreenUpdating = False

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

For Each ws In Thiswb.Worksheets

If ws.Name = "RawData" Or ws.Name = "Category" Or ws.Name = "Brand" Or ws.Name = "FilteredData" Then

Thiswb.Sheets(ws.Name).Visible = True

End If

Next

ws_Report.Activate

Range("A1").Select

End Sub

Public Sub HideWorkbooks()

Application.ScreenUpdating = False

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

For Each ws In Thiswb.Worksheets

If ws.Name = "RawData" Or ws.Name = "Category" Or ws.Name = "Brand" Or ws.Name = "FilteredData" Then

Thiswb.Sheets(ws.Name).Visible = False

End If

Next

ws_Report.Activate

Range("A1").Select

End Sub

Public Sub NextTab()

Set Thiswb = ThisWorkbook

Set ws_Report = Thiswb.Sheets("Report")

ws_Report.Activate

Range("A1").Select
End Sub

I Hope this tutorials will help you to code for Multiple Selection and Filtering Logic in VBA

Tutorial  on Multiple Selection and Filtering Logic