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.
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.
Code:
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
