Hi Ashley
This Code in the attached could be shortened up but it appears to do the job. CTRL + x will fire the Code. Let me know of issues.
Option Explicit
Sub Filter_Stuff()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim LR As Long
Dim i As Long
Dim myFilter As String
Dim myFilter4() As Variant
Application.ScreenUpdating = False
Set ws = Sheets("AUDIT LIST")
With ws
LR = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
If Not .AutoFilterMode Then
.Rows("1:1").AutoFilter
End If
For i = 1 To 4
Select Case i
Case 1
myFilter = "RM"
.Range("A1:M5" & LR).AutoFilter Field:=7, Criteria1:=myFilter
If Not Evaluate("isref(" & myFilter & "!A1)") Then
Worksheets.Add(After:=Sheets(1)).Name = myFilter
Else
Sheets(myFilter).UsedRange.Clear
End If
Set ws1 = Sheets(myFilter)
With ws1
ws.Range(ws.Cells(1, 1), ws.Cells(LR, "M")).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial Paste:=8
.Range("A1").PasteSpecial (xlPasteValues)
End With
Case 2
myFilter = "PP"
.Range("A1:M5" & LR).AutoFilter Field:=7, Criteria1:=myFilter
If Not Evaluate("isref(" & myFilter & "!A1)") Then
Worksheets.Add(After:=Sheets(1)).Name = myFilter
Else
Sheets(myFilter).UsedRange.Clear
End If
Set ws1 = Sheets(myFilter)
With ws1
ws.Range(ws.Cells(1, 1), ws.Cells(LR, "M")).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial Paste:=8
.Range("A1").PasteSpecial (xlPasteValues)
End With
Case 3
myFilter = "AD"
.Range("A1:M5" & LR).AutoFilter Field:=7, Criteria1:=myFilter
If Not Evaluate("isref(" & myFilter & "!A1)") Then
Worksheets.Add(After:=Sheets(1)).Name = myFilter
Else
Sheets(myFilter).UsedRange.Clear
End If
Set ws1 = Sheets(myFilter)
With ws1
ws.Range(ws.Cells(1, 1), ws.Cells(LR, "M")).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial Paste:=8
.Range("A1").PasteSpecial (xlPasteValues)
End With
Case 4
myFilter4 = Array("DL", "FD", "LP", "DM")
.Range("A1:M5" & LR).AutoFilter Field:=7, Criteria1:=myFilter4, Operator:=xlFilterValues
If Not Evaluate("isref('Pre-Legal and Demand'!A1)") Then
Worksheets.Add(After:=Sheets(1)).Name = "Pre-Legal and Demand"
Else
Sheets("Pre-Legal and Demand").UsedRange.Clear
End If
Set ws1 = Sheets("Pre-Legal and Demand")
With ws1
ws.Range(ws.Cells(1, 1), ws.Cells(LR, "M")).SpecialCells(xlCellTypeVisible).Copy
.Range("A1").PasteSpecial Paste:=8
.Range("A1").PasteSpecial (xlPasteValues)
End With
End Select
Next i
.AutoFilterMode = False
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Bookmarks