Behavior in Dropdown Menu List

cbryan15

New Member
Joined
Mar 5, 2013
Messages
24
Good day!

I would like to ask your help regarding the vba code that I need to enter in making my list automated.

What I want is that whenever I select from the dropdown menu, the table will be automatically be filtered without including the blank ones. I was able to attain this, but, an error appears. It needs me to have the table, initially filtered.

Here is my code.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)    
    ActiveSheet.Unprotect Password:="PASS"
    
    If Target.Address(True, True) = "$B$7" Then
        Select Case Target
        
            Case ""
                Range("B12:G12").Select
                ActiveSheet.ShowAllData
                Range("C13").Select
                           
                Range("C12:G262").Select
                Selection.ClearContents
                Application.ScreenUpdating = False
                Range("B7").Select
        
            Case "SHEET 1"
                Range("B12:G12").Select
                ActiveSheet.ShowAllData
                Range("C13").Select
                            
                Range("J13:N262").Select
                Selection.Copy
                Range("C13").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Application.CutCopyMode = False
                Application.ScreenUpdating = False
                   
                Range("C13:G262").Select
                Application.AddCustomList ListArray:=Array("1", "2", "3", "4" _
                    , "5", "6", "7", "8", "T9", "10")
                ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
                ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
                    "E13:E262"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
                    "1,2,3,4,5,6,7,8,9,10" _
                    , DataOption:=xlSortNormal
                ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
                    "G13:G262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                    xlSortNormal
                ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range( _
                    "D13:D262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                    xlSortNormal
                With ActiveWorkbook.ActiveSheet.Sort
                    .SetRange Range("C13:G262")
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                Application.ScreenUpdating = False
                End With
                
                ActiveSheet.Unprotect Password:="PASS"
                Range("C13:G262").Select
                Selection.Replace What:="ZZ", Replacement:="", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
                Range("B7").Select
                Application.ScreenUpdating = False
                
                Range("B7").Select
                Application.ScreenUpdating = False
            Case Else
                'Do nothing
        End Select
    End If
    ActiveSheet.Protect Password:="PASS", AllowFiltering:=True
    
End Sub

So, where could I put this code to make it work?

Code:
    ActiveSheet.Range("$B$12:$G$262").AutoFilter Field:=2, Criteria1:="<>"

Or, is my code correct?

Kindly, I need your help badly.

Thank you very much!

More power to you all!
 

Some videos you may like

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,065
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
After the unprotect line, try adding:
Code:
activesheet.autofiltermode = False
ActiveSheet.Range("$B$12:$G$262").AutoFilter Field:=2, Criteria1:="<>"
 

cbryan15

New Member
Joined
Mar 5, 2013
Messages
24
Thank you very much Mr. RoryA.

I am still having a problem here. I run the code and whenever I choose from the menu list, the Excel file gets unresponding. :confused::(

Please help again...

Thank you very much!
 

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,065
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)    
    Me.Unprotect Password:="PASS"
    Me.autofiltermode = False
    Range("$B$12:$G$262").AutoFilter Field:=2, Criteria1:="<>"
    If Target.Address(True, True) = "$B$7" Then
        On Error Goto Fix_it
        Application.screenupdating = false
        Application.Enableevents = False
        Select Case Target
            Case ""
                Me.ShowAllData
                Range("C12:G262").ClearContents
        
            Case "SHEET 1"
                Me.ShowAllData
                Range("J13:N262").Copy
                Range("C13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                              SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
                Application.AddCustomList ListArray:=Array("1", "2", "3", "4", "5", "6", "7", "8", "T9", "10")
                Me.Sort.SortFields.Clear
                Me.Sort.SortFields.Add Key:=Range("E13:E262"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                                  CustomOrder:="1,2,3,4,5,6,7,8,9,10", DataOption:=xlSortNormal
                Me.Sort.SortFields.Add Key:=Range("G13:G262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                Me.Sort.SortFields.Add Key:=Range("D13:D262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With Me.Sort
                    .SetRange Range("C13:G262")
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
               
                Range("C13:G262").Replace What:="ZZ", Replacement:="", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
            Case Else
                'Do nothing
        End Select
    End If
    
clean_up:
    Me.Protect Password:="PASS", AllowFiltering:=True
    Application.Enableevents = true
    application.screenupdating = true
    exit sub

Fix_it:
    Resume clean_up
End Sub
 

cbryan15

New Member
Joined
Mar 5, 2013
Messages
24
Try this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)    
    Me.Unprotect Password:="PASS"
    Me.autofiltermode = False
    Range("$B$12:$G$262").AutoFilter Field:=2, Criteria1:="<>"
    If Target.Address(True, True) = "$B$7" Then
        On Error Goto Fix_it
        Application.screenupdating = false
        Application.Enableevents = False
        Select Case Target
            Case ""
                Me.ShowAllData
                Range("C12:G262").ClearContents
        
            Case "SHEET 1"
                Me.ShowAllData
                Range("J13:N262").Copy
                Range("C13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                                              SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False
                Application.AddCustomList ListArray:=Array("1", "2", "3", "4", "5", "6", "7", "8", "T9", "10")
                Me.Sort.SortFields.Clear
                Me.Sort.SortFields.Add Key:=Range("E13:E262"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                                                  CustomOrder:="1,2,3,4,5,6,7,8,9,10", DataOption:=xlSortNormal
                Me.Sort.SortFields.Add Key:=Range("G13:G262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                Me.Sort.SortFields.Add Key:=Range("D13:D262"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With Me.Sort
                    .SetRange Range("C13:G262")
                    .Header = xlGuess
                    .MatchCase = False
                    .Orientation = xlTopToBottom
                    .SortMethod = xlPinYin
                    .Apply
                End With
               
                Range("C13:G262").Replace What:="ZZ", Replacement:="", LookAt:=xlPart, _
                    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                    ReplaceFormat:=False
            Case Else
                'Do nothing
        End Select
    End If
    
clean_up:
    Me.Protect Password:="PASS", AllowFiltering:=True
    Application.Enableevents = true
    application.screenupdating = true
    exit sub

Fix_it:
    Resume clean_up
End Sub

Thank you very much for your kind help Mr. RoryA. God bless!
 

Watch MrExcel Video

Forum statistics

Threads
1,122,298
Messages
5,595,310
Members
413,986
Latest member
Elizsk

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top