Match Stock Prices with Stock Splits VBA

[FranticIntern]

Greetings (first post and I am in need of help)!

I am writing some VBA and here is what I would like to do but I am having difficulty creating the structure.

I have a list of daily stock prices for multiple companies, although the stock prices do not indicate that they went through a stock split. So what I need to do is match the range of companies stock prices to the range of stock split factors and divide them so they undo. Sounds easy enough.

A simple version would look like this:

[TABLE="width: 1000"]
<tbody>[TR]
[TD]Ticker[/TD]
[TD]Date[/TD]
[TD]Price[/TD]
[TD](After Code)[/TD]
[TD]Ticker[/TD]
[TD]Split Date[/TD]
[TD]Split Factor[/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]1/1/00[/TD]
[TD]100[/TD]
[TD]100[/TD]
[TD]xxx[/TD]
[TD]1/2/00[/TD]
[TD].5[/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]1/2/00[/TD]
[TD]50[/TD]
[TD]50/.5 = 100[/TD]
[TD]yyy[/TD]
[TD]1/3/00[/TD]
[TD].25[/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]1/3/00[/TD]
[TD]51[/TD]
[TD]51/.5 = 102[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]1/4/00[/TD]
[TD]52[/TD]
[TD]52/.5 = 104[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]xxx[/TD]
[TD]1/5/00[/TD]
[TD]51[/TD]
[TD]51/.5 = 102[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yyy[/TD]
[TD]1/1/00[/TD]
[TD]195[/TD]
[TD]195[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yyy[/TD]
[TD]1/2/00[/TD]
[TD]200[/TD]
[TD]200[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yyy[/TD]
[TD]1/3/00[/TD]
[TD]50[/TD]
[TD]50/.25 = 200[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]yyy[/TD]
[TD]1/4/00[/TD]
[TD]48[/TD]
[TD]48/.25 = 142[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Now I have about 500 different companies with 20 years of data so that's almost a million lines of stock prices, and I have about only 100 different stock splits that I need to account for. I need help structuring this code!

So far I have started on the dim process and not sure what i should do next.

Sub Splits()


Dim WB As Workbook
Dim WS As Worksheet
Dim PriceSplits As Worksheets
Dim SplitTICKER As Range
Dim SplitDATE As Range
Dim SplitFACTOR As Range
Dim PriceTICKER As Range
Dim PriceDATE As Range
Dim PriceCLOSE As Range
Dim cell As Range




Set WB = ThisWorkbook
Set WS = WB.Worksheets("PriceSplits")


Set SplitTICKER = WS.Range(Cells(2, 5), Cells(117, 5))
Set SplitDATE = WS.Range(Cells(2, 6), Cells(117, 6))
Set SplitFACTOR = WS.Range(Cells(2, 7), Cells(117, 7))
Set PriceTICKER = WS.Range(Cells(2, 1), Cells(986732, 1))
Set PriceDATE = WS.Range(Cells(2, 2), Cells(986732, 2))
Set PriceCLOSE = WS.Range(Cells(2, 3), Cells(986732, 3))




''''''Should I set this up as
'for each cell in rng


'' then ...idk


End Sub

 

[tonyyy]

FranticIntern,

Welcome to the Board.

For such a large data set, you might consider using arrays rather than ranges...

Sub Splits_1059342()
Dim WS As Worksheet
Dim LastRow1 As Long, LastRow2 As Long
Dim arr1 As Variant, arr2 As Variant
Dim i As Long, j As Long

On Error GoTo errHandler
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets("PriceSplits")
LastRow1 = WS.Cells(Rows.Count, "A").End(xlUp).Row
LastRow2 = WS.Cells(Rows.Count, "E").End(xlUp).Row
arr1 = WS.Range(Cells(2, 1), Cells(LastRow1, 4)).Value
arr2 = WS.Range(Cells(2, 5), Cells(LastRow2, 7)).Value

For i = LBound(arr1) To UBound(arr1)
    arr1(i, 4) = arr1(i, 3)
    For j = LBound(arr2) To UBound(arr2)
        If arr1(i, 1) = arr2(j, 1) And arr1(i, 2) >= arr2(j, 2) Then
            arr1(i, 4) = arr1(i, 3) / arr2(j, 3)
            Exit For
        End If
    Next j
Next i

errHandler:
    WS.Range(Cells(2, 1), Cells(10, 4)).Value = arr1
    If Err.Number > 0 Then MsgBox Err.Number & " " & Err.Description, Title:="Error"
End Sub

Cheers,

tonyyy