VBA Date range on IF statement, and count instances of appearance

[muizac]

Hi there,

Thanks for looking. I'm not bad at excel but visual basic is alien to me. I have a macro to extract a list of records if it's today's date. It works great. But rather than extracting only today's date, I'd like it to include the past 2 weeks as well (ie - date range From: minus 14 days To: today), plus append a column to count how many times a name appears in the extracted list (column C). The extract will look like this (column A is blank)

B1...................................C1...........D1
Monday, 27 March 2017......Andrew.....2
Tuesday, 28 March 2017......Andrew.....2
Tuesday, 28 March 2017......Barry........1

the Macro to ammend is....

Option Explicit

Sub FREQ()

Dim Today As Date
Dim LastRow As Long, I As Long
Dim J As Long
Application.EnableEvents = False ' TO AVOID TO LAUNCH SHEET EVENT MACRO
Today = Date
Range("B26:L" & Range("B" & Rows.Count).End(xlUp).Row + 1).ClearContents
With Sheets("Schedule")
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
J = 2
For I = 2 To LastRow
If (.Cells(I, "D") = Today) Then
Cells(J, "B") = Today
Cells(J, "B").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Cells(J, "C") = .Cells(I, "C")

J = J + 1
End If
Next I
End With
Application.EnableEvents = True ' TO PERMIT TO LAUNCH SHEET EVENT MACRO
' Macro1 Macro
End Sub


Thank you so much for your help, it's very much appriciated.
Have a great day
Muizac

 

[Joe4]

Try this:

Sub FREQ()


    Dim Today As Date
    Dim LastRow As Long, I As Long
    Dim J As Long


    Application.EnableEvents = False ' TO AVOID TO LAUNCH SHEET EVENT MACRO


    Today = Date
    Range("B26:L" & Range("B" & Rows.Count).End(xlUp).Row + 1).ClearContents
    
    With Sheets("Schedule")
        LastRow = .Range("D" & Rows.Count).End(xlUp).Row
        J = 2
        For I = 2 To LastRow
            If (.Cells(I, "D") >= (Today - 14)) Then
                Cells(J, "B") = .Cells(I, "D")
                Cells(J, "B").NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
                Cells(J, "C") = .Cells(I, "C")
                Cells(J, "D").FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
                J = J + 1
            End If
        Next I
    End With
    
Application.EnableEvents = True ' TO PERMIT TO LAUNCH SHEET EVENT MACRO


' Macro1 Macro
End Sub