# Obtaining yearly change



## ElyM (Dec 31, 2022)

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 (Dec 31, 2022)

```
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 (Dec 31, 2022)

Your profile indicates you have the latest version of Excel with its new Array Formula engine. Why not just use a formula?
Book1DEF7DateValue% Change801/02/20203,257.85901/03/20203,234.85-0.71%1001/06/20203,246.280.35%1101/07/20203,237.18-0.28%1201/08/20203,253.050.49%1301/09/20203,274.700.67%1401/10/20203,265.35-0.29%1501/13/20203,288.130.70%1601/14/20203,283.15-0.15%1701/15/20203,289.290.19%1801/16/20203,316.810.84%1901/17/20203,329.620.39%2001/21/20203,320.79-0.27%2101/22/20203,321.750.03%2201/23/20203,325.540.11%2301/24/20203,295.47-0.90%2401/27/20203,243.63-1.57%2501/28/20203,276.241.01%2601/29/20203,273.40-0.09%2701/30/20203,283.660.31%2801/31/20203,225.52-1.77%2902/03/20203,248.920.73%3002/04/20203,297.591.50%3102/05/20203,334.691.13%3202/06/20203,345.780.33%3302/07/20203,327.71-0.54%3402/10/20203,352.090.73%3502/11/20203,357.750.17%3602/12/20203,379.450.65%3702/13/20203,373.94-0.16%3802/14/20203,380.160.18%Sheet4Cell FormulasRangeFormulaF9:F38F9=E9/E8-1


----------



## shinigamilight (Dec 31, 2022)

```
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 (Dec 31, 2022)

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.xlsxABCDEFGHIJKL1TickerDataOpenHighLowCloseVol2AAB2-1-202020AAB203AAB3-1-2020AAF-334AAB31-12-202040Microsoft-265AAF2-1-202056Tesla22,226AAF31-12-2020237Microsoft2-1-2020708Microsoft3-1-2020439Microsoft3-1-20204610Microsoft5-1-20204211Microsoft31-12-20204412Tesla2-1-20202313Tesla5-1-20206714Tesla31-12-202045,22Blad1


----------



## ElyM (Dec 31, 2022)

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 (Jan 1, 2023)

ElyM said:


> 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 - GitHub - VBA-tools/VBA-Dictionary: Drop-in replacement for Scripting.Dictionary on Mac




					github.com


----------



## ElyM (Jan 4, 2023)

shinigamilight said:


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


Thank you very much for this information!


----------

