VBA Code for Dropdown List with Assigned Macros

[benri]

Hi everyone,

Long time forum searcher, first time posting.

I am hoping to get some direction with code that has completely stumped me. I have written code that is pretty basic, and the end result is a workbook with a number of columns with thousands of rows of data. Currently the code creates three worksheets in the same workbook to view the data different ways (via AutoFilter), but I'd much rather have a single worksheet with a dropdown list so a user could select a few ways to view the data. I have scoured the web looking for a solution, but it eludes me.

I was able to write code that creates the dropdown list with the three filter views, but no action is taken when selecting any of the drop down items.

The code I am posting below is the second set of procedures. I am very new to VBA, so please be gentle.

Thanks to everyone in advance for taking the time to read this.

Option Explicit


Sub LocTrackerMacro2()


' localization tracker macro2, second set of procedures ; module 3


    Dim Output As Workbook, Source As Workbook
    Dim sh As Worksheet
    Dim FileName As String
    Dim firstcell
    
    Application.ScreenUpdating = False
    Set Source = ActiveWorkbook
    
    Set Output = Workbooks.Add
    Application.DisplayAlerts = False
    
    Dim i As Integer
    
    For Each sh In Source.Worksheets
    
        Dim NewSheet As Worksheet
        
        ' select all used cells in the source sheet
        sh.Activate
        sh.UsedRange.Select
        Application.CutCopyMode = False
        Selection.Copy
        
        ' create new destination sheet
        Set NewSheet = Output.Worksheets.Add
        NewSheet.Name = "AllEvents"
        
        ' make sure the destination sheet is selected with right cell
        NewSheet.Activate
        firstcell = sh.UsedRange.Cells(1, 1).Address
        NewSheet.Range(firstcell).Select
        
        ' paste the values
        Range(firstcell).PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=True, Transpose:=False
        
        ' delete the empty sheet in the new workbook
        Worksheets("Sheet1").Delete
        
        ' turn on autofilter
        If ActiveSheet.AutoFilterMode = True Then
        ' do nothing
        Else
        ActiveSheet.Range("A1:S1").AutoFilter
        End If
        
        ' basic formatting
        Range("A:A,C:D,I:I").Delete
        Range("A1:O1").Interior.ColorIndex = 37
        Range("A1:O1").WrapText = True
        Columns("A:C").EntireColumn.AutoFit
        Columns("D:E").ColumnWidth = 15
        Columns("F").ColumnWidth = 20
        Columns("G:H").ColumnWidth = 8
        Columns("I").ColumnWidth = 10
        Columns("J").ColumnWidth = 20
        Columns("K").ColumnWidth = 9
        Columns("L:M").ColumnWidth = 20
        Columns("N:O").ColumnWidth = 10
        Rows("2:2").Select
        ActiveWindow.FreezePanes = True
        
        ' copying the allevents sheet for noMainsEnds data
        Sheets("AllEvents").Copy After:=Sheets("AllEvents")
        ActiveSheet.Name = "noMainsEnds"
        
        ' filter to exclude mains and ends
        Range("F:F").AutoFilter Field:=6, Criteria1:=Array( _
        "Foreign Dialogue-No Subtitles", "Main Title", "Narrative Title", "On-Screen Text" _
        , "Subtitle"), Operator:=xlFilterValues
        
       ' copying the allevents sheet for sub decisions data
        Sheets("AllEvents").Copy After:=Sheets("noMainsEnds")
        ActiveSheet.Name = "SubDecisions"
        
        ' filter sub decisions
        Range("D:D").AutoFilter Field:=4, Criteria1:="Subtitle"
        
        Sheets("AllEvents").Select
        
        
    Next
    Application.ScreenUpdating = True
    
' everything below is new test code


' insert row


'Range("A1").EntireRow.Insert


' adjust row height


'Rows(1).RowHeight = 17


' create combo box for tracker views


Worksheets("AllEvents").DropDowns.Add(0, 0, 100, 15).Name = "TrackerViews"


    ' add values to the tracker views combo box


    With Worksheets("AllEvents").Shapes("TrackerViews").ControlFormat
        .AddItem "All Events"
        .AddItem "No Mains & Ends"
        .AddItem "Sub Decisions"


    End With
    
        
End Sub




Private Sub Worksheet_Change(ByVal Target As Range)


    'Application.EnableEvents = False
    
    'If Not Intersect(Target, Range("A1")) Is Nothing Then
        'Select Case Target.Value
        
        If Target.Count > 1 Then Exit Sub
        If Target.Address <> "$A$1" Then Exit Sub
        Select Case Target
        
            Case "All Events"
                ActiveSheet.ShowAllData
                
            Case "No Mains & Ends"
                ActiveSheet.ShowAllData
                ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=6, Criteria1:= _
               "Main Title"
               
            Case "Sub Decisions"
                
                ActiveSheet.ShowAllData
                ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=4, Criteria1:= _
                "Subtitle"
                
            Case Else
                
        End Select
    End If
    Application.EnableEvents = True
    
End Sub


'Private Sub Worksheet_Change(ByVal Target As Range)


    'If Not Intersect(Target, Range("A1")) Is Nothing Then
        'Select Case Range("A1")
        
            'Case "All Events": ResetFilter
            'Case "No Mains & Ends": MainsEndsFilter
            'Case "Sub Decisions": SubDecisionsFiler
        'End Select
        


'End Sub


'Sub DropDown_Click(ByVal Target As Range)


'Dim drpdwn As DropDown
'Set drpdwn = ActiveSheet.DropDowns(Application.Caller)
'Select Case drpdwn.ListIndex


    'If Target.Address = "$A$1" Then
    'Select Case Target.Value
    
    'Case "All Events"
            'Call ResetFilter
            'module 8
            
    'Case "No Mains & Ends"
            'Call MainsEndsFilter
            'module 5
            
    'Case "Sub Decisions"
            'Call SubDecisionsFilter
            'module 7
    
    'Case Else 'do nothing
    
    'End Select
    


'If Not Intersect(Target, Range("A1")) Is Nothing Then
    
    
    'Select Case Range("A1")
        
        
            
    'End Select
    
'End Sub

 

[Fluff]

What type of "drop down" are you using?

 

[benri]

Hi Fluff,

I am creating a combo box via dropdowns.add

If there is a better way to create the drop down, I am open to suggestions.

Also, neglected to mention I am running Office365 ProPlus.

 

[Fluff]

I'd tend to use a data validation dropdown, that way you can use a Worksheet_Change event.
Have a look here & use a delimited list (towards the bottom)

 

[benri]

Hi Fluff,

Thank you for taking the time to read and respond to my inquiry. I have played around with the data validation feature to create the dropdown list. However, I am still unclear on how to have a selected item in the list perform an action. In my case, it's simply adjusting the filters to view the data different ways.

Are you able to offer some guidance on how best to accomplish this?

Many thanks,
Ben

 

[Fluff]

You should be able to do it with this

Private Sub Worksheet_Change(ByVal Target As Range)
        
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address <> "[COLOR=#ff0000]$A$1[/COLOR]" Then Exit Sub
   Application.EnableEvents = False
   ActiveSheet.ShowAllData

   Select Case Target.Value
      Case "All Events"
      Case "No Mains & Ends"
         ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=6, Criteria1:="Main Title"
      Case "Sub Decisions"
         ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=4, Criteria1:="Subtitle"
   End Select
   
   Application.EnableEvents = True
   
End Sub

Change the address to reflect the location of your dropdown.
The code needs to go in the sheet module containing your data.

 

[benri]

Thank you, Fluff. I have entered the code you provided on the sheet module. However, it seems to be failing on the ActiveSheet.ShowAllData

Once that line of code fires, it brings up the VBA window with that row highlighted.

 

[Fluff]

Ok try this

Private Sub Worksheet_Change(ByVal Target As Range)
   
   If Target.CountLarge > 1 Then Exit Sub
   If Target.Address <> "$A$1" Then Exit Sub
   Application.EnableEvents = False
   If Me.FilterMode Then Me.ShowAllData

   Select Case Target.Value
      Case "All Events"
      Case "No Mains & Ends"
         ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=6, Criteria1:="Main Title"
      Case "Sub Decisions"
         ActiveSheet.Range("$A$1:$O$1493").AutoFilter Field:=4, Criteria1:="Subtitle"
   End Select
   
   Application.EnableEvents = True
   
End Sub

 

[benri]

Terribly sorry for the back and forth on this. The newly provided code doesn't throw any error, but is not performing the expected actions (i.e. changing the filtered views). I'm not entirely sure why this is. Could you offer any further suggestions?

 

[Fluff]

Add the line shown

[COLOR=#ff0000]MsgBox"Hi"[/COLOR]
If Target.CountLarge > 1 Then Exit Sub

When you change the dopdown down value do you get the message box appear?
If not run this

Sub chk()
Application.EnableEvents = True
End Sub

& try the dropdown again