Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim cwks As WorkSheet '<<<<<<<<<<<<<<<<<< Dim ws As Worksheet Dim ShName As String Dim aCell As Range Dim folderPath As String If Intersect(Range("O2:O400"), Target) Is Nothing Then Exit Sub If WorksheetFunction.IsError(Target.Value) Then Exit Sub If Target.Value = "" Then Exit Sub 'Uncomment below after testing With Application '.DisplayAlerts = False '.ScreenUpdating = False End With Cancel = True 'This sub will do all the work needed With ThisWorkbook Set cwks = .Sheets(2) folderPath = .Path ShName = Left(Target.Value, Len(Target.Value) - 1) On Error Resume Next .Sheets(ShName).Delete On Error GoTo 0 Set ws = .Sheets.Add(After:= .Sheets(.Sheets.Count)) End With With cwks .AutoFilterMode = False .Range("A1:Y1").AutoFilter .Range("A1:Y1").AutoFilter Field:=1, Criteria1:=ShName) .AutoFilter.Range.Interior.Color = .DisplayFormat.Interior.Color .AutoFilter.Range.Copy End With 'sheets(2) With ws .Name = ShName .Paste .Cells.EntireColumn.AutoFit .activate With ActiveWindow .SplitColumn = 0 .SplitRow = 1 .FreezePanes = True End With 'Active Window End With 'New Sheet With Application .DisplayAlerts = True .ScreenUpdating = True End With End Sub