Obtaining yearly change

[ElyM]

Hello,

I am very new to Excel / VBA scripting so I apologize in advance.

I have a series of stocks (over 20,000 data values), with associated dates, open, close, total stock volumes in corresponding columns.

What I am trying to do is calculate yearly change for each unique variable from close date of (December 31, 2020) and open date of (January 2, 2020). I am trying to do this for each unique variable.

The below first image are the columns... I was able to obtain the unique variables in Column I. I am now having a difficult time figuring out what I need to do to obtain the specific value on the close date and open date for each unique variable (only once) and place it in Column J.

This was my code to obtain my unique variables from Column A.
' Identify variables used/ define variables / code for Column I - Ticker
Dim wb As Workbook
Dim ws As Worksheet
Dim RngI As Range

Set wb = ThisWorkbook
Set ws = wb.Worksheets("A")
Set RngI = ws.Range("I1")

ws.Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopytoRange:=RngI, Unique:=True

' Bold title for Column I - Ticker
With Range("I1")
.Value = "Ticker"
.Font.Bold = True
End With


Now... I am uncertain where to go from here. I have the below... I tried doing a Vlookup first to see if I could even obtain the close date value for each unique variable... but I am getting an error.

' Identify variables/ Define variables / Place into Column J - Track Change
' Code for close date - open date for each unique variable
Dim i As Long
Dim EndRow As Long
Dim OpenDate As Date
Dim CloseDate As Date

EndRow = RngI.End(xlDown).Row
Set RngB = Range("B:F")
OpenDate = DateSerial(2020, 1, 2)
CloseDate = DateSerial(2020, 12, 31)

For i = 2 To EndRow
ws.Cells(i, 10) = Application.WorksheetFunction.VLookup(CloseDate, RngB, 6, 1)

Next i

End Sub



Any assistance is greatly appreciated!!

Regards,

E.

 

[shinigamilight]

Sub mon()
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        Dim k, i, j As Integer
        Dim store As String
        Dim lr As Long
        Dim StartDate, EndDate As String
        Dim StartDateValue, EndDateValue As Double
        StartDate = "20200102"
        EndDate = "20201231"
        lr = Range("A" & Rows.Count).End(xlUp).Row
      
        For k = 2 To lr
                store = Range("A" & k)
           If dic.exists(store) = False Then
                dic(store) = 1
              Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = store
              For i = 2 To lr
                If Range("A" & i) = store And Range("B" & i) = StartDate Then
                    StartDateValue = Range("A" & i).Offset(0, 5)
                    Exit For
                End If
              Next i
            
              For j = 2 To lr
                If Range("A" & j) = store And Range("B" & j) = EndDate Then
                    EndDateValue = Range("A" & j).Offset(0, 5)
                    Exit For
                End If
              Next j
            Range("I" & Rows.Count).End(xlUp).Offset(0, 1) = EndDateValue - StartDateValue
            End If
          
        Next k
      

End Sub

I used closing price for calculation of yearly change.

Enable dictionary in the compiler using this link

VBA Dictionary | Steps to Create Dictionary in Excel VBA

Guide to the definition of VBA Dictionary and Steps to create a Dictionary in Excel using VBA code along with downloadable excel template.

www.educba.com

 

[jdellasala]

Your profile indicates you have the latest version of Excel with its new Array Formula engine. Why not just use a formula?

Book1
	D	E	F
7	Date	Value	% Change
8	01/02/2020	3,257.85
9	01/03/2020	3,234.85	-0.71%
10	01/06/2020	3,246.28	0.35%
11	01/07/2020	3,237.18	-0.28%
12	01/08/2020	3,253.05	0.49%
13	01/09/2020	3,274.70	0.67%
14	01/10/2020	3,265.35	-0.29%
15	01/13/2020	3,288.13	0.70%
16	01/14/2020	3,283.15	-0.15%
17	01/15/2020	3,289.29	0.19%
18	01/16/2020	3,316.81	0.84%
19	01/17/2020	3,329.62	0.39%
20	01/21/2020	3,320.79	-0.27%
21	01/22/2020	3,321.75	0.03%
22	01/23/2020	3,325.54	0.11%
23	01/24/2020	3,295.47	-0.90%
24	01/27/2020	3,243.63	-1.57%
25	01/28/2020	3,276.24	1.01%
26	01/29/2020	3,273.40	-0.09%
27	01/30/2020	3,283.66	0.31%
28	01/31/2020	3,225.52	-1.77%
29	02/03/2020	3,248.92	0.73%
30	02/04/2020	3,297.59	1.50%
31	02/05/2020	3,334.69	1.13%
32	02/06/2020	3,345.78	0.33%
33	02/07/2020	3,327.71	-0.54%
34	02/10/2020	3,352.09	0.73%
35	02/11/2020	3,357.75	0.17%
36	02/12/2020	3,379.45	0.65%
37	02/13/2020	3,373.94	-0.16%
38	02/14/2020	3,380.16	0.18%
Sheet4

Cell Formulas
Range	Formula
F9:F38	F9	=E9/E8-1

 

[shinigamilight]

Sub mon()
        Dim dic As Object
        Set dic = CreateObject("Scripting.Dictionary")
        Dim k, i, j As Integer
        Dim store As String
        Dim lr As Long
        Dim StartDate, EndDate As String
        Dim StartDateValue, EndDateValue As Double
        StartDate = "20200102"
        EndDate = "20201231"
        lr = Range("A" & Rows.Count).End(xlUp).Row
        
        For k = 2 To lr
                store = Range("A" & k)
           If dic.exists(store) = False Then
                dic(store) = 1
              Range("I" & Rows.Count).End(xlUp).Offset(1, 0) = store
               
              For i = k To lr
                If Range("A" & i) = store And Range("B" & i) = StartDate Then
                    StartDateValue = Range("A" & i).Offset(0, 5)
                    Exit For
                End If
              Next i
              k = i
              For j = k To lr
                If Range("A" & j) = store And Range("B" & j) = EndDate Then
                    EndDateValue = Range("A" & j).Offset(0, 5)
                    Exit For
                End If
              Next j
            Range("I" & Rows.Count).End(xlUp).Offset(0, 1) = ((EndDateValue - StartDateValue) / StartDateValue)
            Range("J:J").NumberFormatLocal = "0.00%"
            End If
           k = j
        Next k
        

End Sub

If you data is arranged in ascending order this one is a faster code.

 

[JEC]

Keep everything in the dictionary. Then write just one time to the sheet.
@shinigamilight, this is based on your data setup

Sub jecc()
 Dim ar, i As Long
 ar = Cells(1).CurrentRegion
 With CreateObject("scripting.dictionary")
   For i = 2 To UBound(ar)
     If ar(i, 2) = DateSerial(2020, 12, 31) Or ar(i, 2) = DateSerial(2020, 1, 2) Then
       If .exists(ar(i, 1)) Then
         .Item(ar(i, 1)) = ar(i, 6) - .Item(ar(i, 1))
       Else
        .Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 6)
       End If
     End If
   Next
  Range("K2").Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
 End With
End Sub

$ teken uit formule.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L
1	Ticker	Data	Open	High	Low	Close	Vol
2	AAB	2-1-2020				20					AAB	20
3	AAB	3-1-2020									AAF	-33
4	AAB	31-12-2020				40					Microsoft	-26
5	AAF	2-1-2020				56					Tesla	22,22
6	AAF	31-12-2020				23
7	Microsoft	2-1-2020				70
8	Microsoft	3-1-2020				43
9	Microsoft	3-1-2020				46
10	Microsoft	5-1-2020				42
11	Microsoft	31-12-2020				44
12	Tesla	2-1-2020				23
13	Tesla	5-1-2020				67
14	Tesla	31-12-2020				45,22
Blad1

 

[ElyM]

Hello,

Thank you all very much!!

I am trying to run the code now... but I am on a Macbook so the "Scripting.Dictionary" is not available. I have been trying to see if I can get it and it is not something that I can run. So, I am looking into how else I can run this.

 

[shinigamilight]

Hello,

Thank you all very much!!

I am trying to run the code now... but I am on a Macbook so the "Scripting.Dictionary" is not available. I have been trying to see if I can get it and it is not something that I can run. So, I am looking into how else I can run this.

GitHub - VBA-tools/VBA-Dictionary: Drop-in replacement for Scripting.Dictionary on Mac

Drop-in replacement for Scripting.Dictionary on Mac - VBA-tools/VBA-Dictionary

github.com

 

[ElyM]

GitHub - VBA-tools/VBA-Dictionary: Drop-in replacement for Scripting.Dictionary on Mac

Drop-in replacement for Scripting.Dictionary on Mac - VBA-tools/VBA-Dictionary

github.com

Thank you very much for this information!