Create Lists for Drop-Down Menus in Different Sheet I'm currently working with a workbook utilized at my work that has the following code.  It currently takes about 10 seconds to complete, and needs to be executed several times throughout utilizing the workbook.  Is there any way to speed up this process?

Right now, the user specifies enters the drop down items needed in Sheet2, the code creates an additional sheet named "Filter Builder", enters the data in a column, which is then copied into the corresponding cell in the Filter Options sheet, and finally pulled by Sheet1 to create a drop down list.

Sub Macro1()

'TURNS OFF THE SCREEN UPDATING SO IT BRING YOU TO THE FILTER OPTIONS TAB AFTER THE MACRO IS COMPLETE
Application.ScreenUpdating = False

'FILTERS OUT THE ROWS THAT DO NOT HAVE "SPECIAL VALIDATION" AND HIDES THEM
ActiveSheet.Range("$A$1:$AF$5150").AutoFilter Field:=5, Criteria1:="Special Validation"

'ADDS ANOTHER SHEET FOR THE DATA TO BE ENTERED INTO
Sheets.Add After:=Sheets(Sheets.Count)

'NAMES THE SHEET AS "FILTER BUILDER"
ActiveSheet.Name = "Filter Builder"

'PASTES THE DATA IN FILTER BUILDER THEN DELIMITS IT
Sheets("Checklist Builder").Columns("F:F").EntireColumn.Hidden = False
Sheets("Checklist Builder").Columns("F:F").Copy Sheets("Filter Builder").Columns("A:A")
Sheets("Checklist Builder").Columns("G:G").Copy Sheets("Filter Builder").Columns("B:B")

'DELIMITS THE DATA SO THE TEXT SPLIT UP IN TO DIFFERENT COLUMNS, DIVIDED UP BY COMMAS
Application.CutCopyMode = False
Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
    True

'SELECTS THE DATA TO TRANSPOSE IT
Sheets("Filter Builder").Rows("2:1150").Select

'COPIES AND TRANSPOSES THE DATA IN THE "FILTER BUILDER" EXCEL SHEET TO "FILTER OPTIONS"
Application.CutCopyMode = False
Selection.Copy
 Sheets("Filter Options").Range("K1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

'AUTO FITS THE COLUMNS IN THE EXCEL SHEET
Sheet3.Cells.EntireColumn.AutoFit

'TURNS OFF THE DISPLAY ALERT TO DELETE THE SHEET
Application.DisplayAlerts = False

'DELETES THE SHEET
Sheets("Filter Builder").Delete

'HIDES COLUMN 'F' IN THE CHECKLIST BUILDER AGAIN
Sheets("Checklist Builder").Columns("F:F").EntireColumn.Hidden = True

'TURNS THE DISPLAY ALERTS BACK ON
Application.DisplayAlerts = True

'TAKES AWAY THE AUTO FILTER THAT WAS APPLIED IN THE "CHECKLIST BUILDER" SHEET
Sheet2.Range("$A$1:$AF$150").AutoFilter Field:=5

'GOES BACK TO THE CHECKLIST BUILDER SHEET
Sheets("Checklist Builder").Select
Range("A1").Select

Application.ScreenUpdating = True

End Sub
This will be hard to get right without the actual workbook. 


Stop adding and removing Sheets("Filter Builder"); just hide it.  
Avoid Select or Activate. Reference: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) 
By working with the data in arrays, you can avoid filtering &amp; unfiltering you data as well as hiding and unhiding the columns.
Use With block to qualify your ranges. Reference: Excel VBA Introduction Part 12 - With Statements
Replace your static ranges ,e.g. .Range("$A$1:$AF$5150"),  dynamic ranges ,e.g. .Range(.Range("A" &amp; .Rows.Count).End(xlup),"AF1"))


Here are some inconsistencies


The initial ActiveSheet, Sheet2 and Sheets("Checklist Builder") all appear to be the same Worksheet.  Pick 1 and use it in a With block. (e.g. With Sheet2)
Range("$A$1:$AF$5150").AutoFilter - .Range("$A$1:$AF$150").AutoFilter




This should work "As Is" but it is hard to say without the actual Workbook.  You will have to add a Worksheet, name it "Filter Builder", hide it and forget about it.  I would guess that it should take less than 1 sec to execute.  

Sub Macro1()

'TURNS OFF THE SCREEN UPDATING SO IT BRING YOU TO THE FILTER OPTIONS TAB AFTER THE MACRO IS COMPLETE
    Application.ScreenUpdating = False

    Dim data As Variant, results As Variant
    Dim count As Long, x As Long
    With Sheets("Checklist Builder")
        data = .Range("$A$1:$AF$5150").Value
        ReDim results(1 To UBound(data), 1 To 2)
        'Fill array with the values
        For x = 1 To UBound(data)
            If count = 1 Or UCase(data(x, 7)) = "SPECIAL VALIDATION" Then
                count = count + 1
                results(count, 1) = data(x, 7)
                results(count, 2) = data(x, 8)
            End If
        Next
    End With


    'DELIMITS THE DATA SO THE TEXT SPLIT UP IN TO DIFFERENT COLUMNS, DIVIDED UP BY COMMAS

    With Sheets("Filter Builder")
        .Cells.Clear
        .Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results

        .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True

        .Rows("2:1150").Copy
        Sheets("Filter Options").Range("K1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                                                                   :=False, Transpose:=True
        Application.CutCopyMode = False
    End With
    Application.ScreenUpdating = True

End Sub