Get First, High, Low, Last value within a given period

[Av8tordude]

I would like to request assistance with a VBA solution. I would like to get the following information below for each month/year and append the information in cell AA2. The dates begin in column (D18 - until) and the values Column (P18 - until). My intention will be to graph the results.

Month/Year

First value
Highest Value
Lowest Value
last Value

I would like the output to be displayed below...

[TABLE="width: 10"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Open[/TD]
[TD]High[/TD]
[TD]Low[/TD]
[TD]Close[/TD]
[/TR]
[TR]
[TD]09/01/18[/TD]
[TD]-60.1[/TD]
[TD]808.21[/TD]
[TD]-112.9[/TD]
[TD]808.21[/TD]
[/TR]
[TR]
[TD]10/01/18[/TD]
[TD]-506.4[/TD]
[TD]2784.1[/TD]
[TD]-779.4[/TD]
[TD]1504.1[/TD]
[/TR]
[TR]
[TD]11/01/18[/TD]
[TD]1981.63[/TD]
[TD]1981.63[/TD]
[TD]466.1[/TD]
[TD]700.1[/TD]
[/TR]
</tbody>[/TABLE]


[TABLE="width: 143"]
<tbody>[TR]
[TD]Date[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]09/28/2018[/TD]
[TD="align: right"]-60.2[/TD]
[/TR]
[TR]
[TD]09/28/2018[/TD]
[TD="align: right"]-112.9[/TD]
[/TR]
[TR]
[TD]09/28/2018[/TD]
[TD="align: right"]348.39[/TD]
[/TR]
[TR]
[TD]09/28/2018[/TD]
[TD="align: right"]199.95[/TD]
[/TR]
[TR]
[TD]09/28/2018[/TD]
[TD="align: right"]808.21[/TD]
[/TR]
[TR]
[TD]10/01/2018[/TD]
[TD="align: right"]-506.4[/TD]
[/TR]
[TR]
[TD]10/01/2018[/TD]
[TD="align: right"]-251.2[/TD]
[/TR]
[TR]
[TD]10/01/2018[/TD]
[TD="align: right"]-779.4[/TD]
[/TR]
[TR]
[TD]10/01/2018[/TD]
[TD="align: right"]758.36[/TD]
[/TR]
[TR]
[TD]10/30/2018[/TD]
[TD="align: right"]1504.1[/TD]
[/TR]
[TR]
[TD]11/01/2018[/TD]
[TD="align: right"]1981.63[/TD]
[/TR]
[TR]
[TD]11/02/2018[/TD]
[TD="align: right"]466.1[/TD]
[/TR]
[TR]
[TD]11/02/2018[/TD]
[TD="align: right"]700.1[/TD]
[/TR]
[TR]
[TD]12/07/2018[/TD]
[TD="align: right"]486.69[/TD]
[/TR]
[TR]
[TD]12/08/2018[/TD]
[TD="align: right"]332.1[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]-2377.9[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]-3023.46[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]-2422.9[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]-2867.9[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]-1898.31[/TD]
[/TR]
[TR]
[TD]12/10/2018[/TD]
[TD="align: right"]1927.1[/TD]
[/TR]
[TR]
[TD]12/11/2018[/TD]
[TD="align: right"]-616.23[/TD]
[/TR]
[TR]
[TD]12/11/2018[/TD]
[TD="align: right"]456.8[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-1118.3[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-1013.49[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-819.9[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-548.48[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-387.9[/TD]
[/TR]
[TR]
[TD]12/12/2018[/TD]
[TD="align: right"]-328.3[/TD]
[/TR]
[TR]
[TD]12/14/2018[/TD]
[TD="align: right"]-518.32[/TD]
[/TR]
[TR]
[TD]12/14/2018[/TD]
[TD="align: right"]-174.09[/TD]
[/TR]
[TR]
[TD]12/14/2018[/TD]
[TD="align: right"]-84[/TD]
[/TR]
[TR]
[TD]12/20/2018[/TD]
[TD="align: right"]-2523.12[/TD]
[/TR]
</tbody>[/TABLE]


Thank you kindly

 

[DanteAmor]

Try this

Sub Get_Values()
    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

 

[Av8tordude]

DanteAmor...I sincerely thank you for your generous help. The code achieves the results, however, on first run, it does not achieve the results. on the second run, it works. Any reason?

Try this

Sub Get_Values()
    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

 

[Av8tordude]

Is it possible to do this weeks? (i.e. find the same thing, but instead of months, use weeks)

 

[DanteAmor]

DanteAmor...I sincerely thank you for your generous help. The code achieves the results, however, on first run, it does not achieve the results. on the second run, it works. Any reason?

It can be the date format.
The date format of column D must be the same format in column AA (mm/dd/yyyy or dd/mm/yyyy)