Change VBA Code

[Av8tordude]

This code creates a table to be able to chart once created. I would to do two things to allow flexibility....

1. Since is table for months, I would like to create the a table for weeks.
2. Select between two dates.

Can anyone assist.. Thank you kindly

Sub ProfitLoss()    Dim dt As Date, c As Range, f As Range
    Dim lr1 As Long, lr2 As Long, y As String, m As String
    
    Range("AA2:AE" & Rows.Count).ClearContents
    lr1 = Range("D" & Rows.Count).End(xlUp).Row
    For Each c In Range("D18", Range("D" & Rows.Count).End(xlUp))
        y = Year(c)
        m = Month(c)
        dt = DateSerial(y, m, 1)
        Set f = Range("AA:AA").Find(dt, LookIn:=xlValues, lookat:=xlWhole)
        If f Is Nothing Then
            lr2 = Range("AA" & Rows.Count).End(xlUp).Row + 1
            Range("AA" & lr2).Value = dt
            Range("AB" & lr2).Value = Cells(c.Row, "P")
            Range("AC" & lr2).Value = Evaluate("=MAX(IF(YEAR(D18:D" & lr1 & ")=" & y & _
                ",IF(MONTH(D18:D" & lr1 & ")=" & m & ",P18:P" & lr1 & ")))")
            Range("AD" & lr2).Value = Evaluate("=MIN(IF(YEAR(D18:D" & lr1 & ")=" & y & _
                ",IF(MONTH(D18:D" & lr1 & ")=" & m & ",P18:P" & lr1 & ")))")
            Range("AE" & lr2).Value = Cells(Evaluate("=MAX(IF(YEAR(D18:D" & lr1 & ")=" & y & _
                ",IF(MONTH(D18:D" & lr1 & ")=" & m & ",ROW(P18:P" & lr1 & "))))"), "P")
        End If
    Next
End Sub

 

[JustynaMK]

Hi,

1. A table for weeks can be created by modifying your "dt" variable. Simply take date that is visible in cell D18 and then, with each loop, add 7 days to it.

dt = DateSerial(Year(Range("D18")), Month(Range("D18")), Day(Range("D18")) + (c.Row() - 18) * 7)

2. Select between two dates - do you want to end your loop before some specific date? If yes, I think this one can be achieved by modifying your "For Each" statement to end with a specific row, e.g.:

For Each c In Range("D18:D30")

I hope it is a good starting point.