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!
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
After the unprotect line, try adding:
Code:
activesheet.autofiltermode = False
ActiveSheet.Range("$B$12:$G$262").AutoFilter Field:=2, Criteria1:="<>"
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,214,950
Messages
6,122,438
Members
449,083
Latest member
Ava19

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
Back
Top