Skip to content

Sharkb8t/VBA-challenge

Folders and files

NameName
Last commit message
Last commit date

Latest commit

 

History

13 Commits
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

Repository files navigation

VBA-challenge

Hi! This README file contains the VBScript code that I used to summarize the stock data statistics.

I ended with this script as it was the most optimized way that I found to summarize the statistical changes in stock data for each datasheet from the assigned Excel workbook.

I needed the script to both show the quarterly change in stock value as well as the percent change and the stock volume traded each quarter.

In addition I needed the script to also show a statistic for 'Greatest % Increase', 'Greatest % Decrease', and 'Greatest Total Volume' for each quarters statistics.

Sub SummarizeStockDataAllSheets()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim outputRow As Long

    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Sheets
     ' Find the last row with data in column A (ticker column) for the current worksheet
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).row
    
        ' Define output start row and set headers for the current sheet
        outputRow = 2 ' First output row after headers
        ws.Range("I1:L1").Value = Array("Ticker", "Quarterly Change", "Percent Change", "Total Stock Volume")
        ws.Range("O1:Q1").Value = Array("", "Ticker", "Value")
    
        ' Collection to hold unique tickers
        Dim uniqueTickers As Object
        Set uniqueTickers = CreateObject("Scripting.Dictionary") ' Faster than Collection
    
        ' Loop through the tickers and collect unique values
        Dim i As Long, ticker As String
        For i = 2 To lastRow
            ticker = ws.Cells(i, 1).Value
            If Len(ticker) > 0 Then
                If Not uniqueTickers.exists(ticker) Then
                    uniqueTickers.Add ticker, ticker
                End If
            End If
        Next i
    
        ' Variables for greatest increase, decrease, and volume
        Dim greatestIncrease As Double: greatestIncrease = -9999999
        Dim greatestDecrease As Double: greatestDecrease = 9999999
        Dim greatestVolume As Double: greatestVolume = 0
    
        ' Variables to store associated tickers
        Dim increaseTicker As String, decreaseTicker As String, volumeTicker As String
    
        ' Loop through each unique ticker to process calculations
        Dim t As Variant, firstOpen As Double, lastClose As Double, totalVol As Double
        Dim quarterlyChange As Double, percentChange As Double
        Dim firstOpenFound As Boolean
    
        For Each t In uniqueTickers.Keys
            totalVol = 0
            firstOpenFound = False
        
            ' Loop through all rows to find first and last occurrence of ticker and sum volume
            For i = 2 To lastRow
                If ws.Cells(i, 1).Value = t Then
                    ' Capture the first open value and the last close value
                    If Not firstOpenFound Then
                        firstOpen = ws.Cells(i, 3).Value
                        firstOpenFound = True
                    End If
                    lastClose = ws.Cells(i, 6).Value
                    totalVol = totalVol + ws.Cells(i, 7).Value
                End If
            Next i

            ' Calculate quarterly change and percent change
            quarterlyChange = lastClose - firstOpen
            percentChange = Round((quarterlyChange / firstOpen) * 100, 2) ' Percent change rounded to 2 decimals

            ' Write to output and apply formatting
            With ws.Cells(outputRow, 9)
                ' Write Ticker
                .Value = t
                ' Write Quarterly Change with number format and color formatting
                .Offset(0, 1).Value = quarterlyChange
                .Offset(0, 1).NumberFormat = "0.00"
                If quarterlyChange > 0 Then
                    .Offset(0, 1).Interior.Color = RGB(144, 238, 144) ' Green
                ElseIf quarterlyChange < 0 Then
                    .Offset(0, 1).Interior.Color = RGB(255, 99, 71) ' Red
                Else
                    .Offset(0, 1).Interior.ColorIndex = xlNone
                End If
                ' Write Percent Change with number format
                .Offset(0, 2).Value = percentChange
                .Offset(0, 2).NumberFormat = "0.00"
                ' Write Total Volume
                .Offset(0, 3).Value = totalVol
            End With

            ' Check for greatest increase, decrease, and volume
            If percentChange > greatestIncrease Then
                greatestIncrease = percentChange
                increaseTicker = t
            End If
            If percentChange < greatestDecrease Then
                greatestDecrease = percentChange
                decreaseTicker = t
            End If
            If totalVol > greatestVolume Then
                greatestVolume = totalVol
                volumeTicker = t
            End If
        
            ' Move to the next output row
            outputRow = outputRow + 1
        Next t

        ' Output the greatest increase, decrease, and volume in columns O, P, Q
        ws.Range("O2:O4").Value = Application.Transpose(Array("Greatest % Increase", "Greatest % Decrease", "Greatest Total Volume"))
        ws.Cells(2, 16).Value = increaseTicker
        ws.Cells(3, 16).Value = decreaseTicker
        ws.Cells(4, 16).Value = volumeTicker
        ws.Cells(2, 17).Value = greatestIncrease
        ws.Cells(3, 17).Value = greatestDecrease
        ws.Cells(4, 17).Value = greatestVolume

    Next ws
End Sub

About

No description, website, or topics provided.

Resources

Stars

Watchers

Forks

Releases

No releases published

Packages

No packages published

Languages