Behavior in Dropdown Menu List

C

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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Sort by date Sort by votes
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
RoryA said:
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
Click to expand...

Thank you very much for your kind help Mr. RoryA. God bless!
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
VBA - Run time error '9': subscript out of range
Replies
3
Views
156
RoryA
RoryA
S
  • Question Question
Help with combining 2 macros into 1
Replies
8
Views
248
MARK858
MARK858
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
262
rollis13
rollis13
P
  • Solved
Macro to scroll to the last coloured cell in a spreadsheet
Replies
4
Views
376
Joe4
Joe4
I
  • Solved
Simplify my working code please
Replies
7
Views
127
ipbr21054
I

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

Share this page

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