VBA Tweak to Include Additional Filter

[welshraz]

Hello!

I have this code which works for pulling data through to another workbook based on dates already in that workbook (i.e. between today's date and a date 3 weeks ahead). What I want it to also do is exclude rows which have the statuses "Complete", "Cancelled", and "Expired", which are in column A, before looking at the dates (column M). I currently have it set up so that another macro gets called after this one to remove the unwanted data, but it's a bit clunky and I hope to be able to streamline it.

Sub PullThreeWeeks()

Dim date1 As Date 'starting date
Dim date2 As Date 'ending date
Dim rng As Range, destRow As Long
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim i As Long
Dim c As Range
Dim d As Range
Set shtSrc = Workbooks("Team Tracker.xlsm").Worksheets("Master")
Set shtDest = Workbooks("Expiry Report Basic.xlsm").Worksheets("Expiring - 3 Weeks")
Set rng = Application.Intersect(shtSrc.Range("M3:M500"), shtSrc.UsedRange)

destRow = 3
 
date1 = CDate(ThisWorkbook.Sheets("Expiring - 3 Weeks").Range("D1"))
date2 = CDate(ThisWorkbook.Sheets("Expiring - 3 Weeks").Range("E1"))

    Windows("Team Tracker.xlsm").Activate
    Sheets("Master").Select
    For Each c In rng.Cells
    If c.Value <= date2 Then
    c.Offset(0, -12).Resize(1, 31).Copy _
                      shtDest.Cells(destRow, 1)

        destRow = destRow + 1

    End If 'Ends search for dates
Next
ThisWorkbook.Sheets("Expiring - 3 Weeks").Activate

End Sub

If it's possible to remove conditional formatting or any cell fill as part of the macro, even better.

Much appreciated.

 

[DanteAmor]

Try this:

Sub PullThreeWeeks()
  Dim date1 As Date, date2 As Date 'starting date and ending date
  Dim rng As Range, c As Range
  Dim shtSrc As Worksheet, shtDest As Worksheet
  Dim destRow As Long
  
  Set shtSrc = Workbooks("Team Tracker.xlsm").Worksheets("Master")
  Set shtDest = ThisWorkbook.Worksheets("Expiring - 3 Weeks")
  Set rng = Application.Intersect(shtSrc.Range("M3:M500"), shtSrc.UsedRange)
  
  date1 = CDate(shtDest.Range("D1"))
  date2 = CDate(shtDest.Range("E1"))
  destRow = 3
  
  For Each c In rng.Cells
    Select Case LCase(shtSrc.Range("A" & c.Row).Value)
      Case LCase("Complete"), LCase("Cancelled"), LCase("Expired")
      
      Case Else
        If c.Value <= date2 Then
          shtDest.Range("A" & destRow).Resize(1, 31).Value = shtSrc.Range("A" & c.Row).Resize(1, 31).Value
          destRow = destRow + 1
        End If
    End Select
  Next
End Sub