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]

1) You can get rid of that code if like. Some times if a macro fails & EnableEvents has been turned off, it won't get turned back on again. Which means that the Worksheet_Change event won't run. All the code from post 10 does is turn Events back on.
2) Adding code programmatically can be done, but it's not something I know much about.

 

[benri]

Thank you so very much for all the help, I sincerely appreciate it!

 

[Fluff]

Glad to help & thanks for the feedback