Direct data tracking

[windbrit]

I have information coming into a cell within excel, this will update many
times a minute. I would like to keep track of these prices, highest price and
lowest price on the day and also a % change from the opening price.

 

[Susan]

this sub will run everytime the value in sheet 1, cell A1 changes. it
will add the new value to a list of cummulative values in sheet 2. as
for the high/low & percent change, you're on your own.
========================
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim mySheet As Worksheet
Dim myLastRow As Long
Dim c As Range

On Error GoTo myError

If Target = Range("A1") Then
Application.EnableEvents = False
Set mySheet = ActiveWorkbook.Worksheets(2)
myLastRow = mySheet.Cells(10000, 1).End(xlUp).Row + 1
Set c = mySheet.Range("a" & myLastRow)
c.Value = Target.Value
Application.EnableEvents = True
Else
Exit Sub
End If

myError:
Application.EnableEvents = True
Exit Sub

'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.

End Sub
=========================
hope it helps!

susan

 

[RyanH]

This code should work beautifully for you. Place this code in the worksheet
module your new price goes too. I assumed you want the data stored in Sheet2
if not, just change the constant I declared. Note: The first price you get
for the day will be in A1 and your precentages will use the A1 value.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Const StorageSheet As String = "Sheet2"
Dim NewRow As Long
Dim myRange As Range
Dim Highest As Range
Dim Lowest As Range
Dim HighestPrice As Currency
Dim LowestPrice As Currency


If Target = Range("A1") Then

' finds last row on StorageSheet
NewRow = Sheets(StorageSheet).Cells(Rows.Count, 1).End(xlUp).Row + 1
If NewRow = 2 Then
Sheets(StorageSheet).Range("A1") = Target.Text
End If

' insert new price
Sheets(StorageSheet).Cells(NewRow, 1) = Target.Text

Set myRange = Sheets(StorageSheet).Range("A1:A" & NewRow)
' reset font color to black
myRange.Font.Color = 1
' clear old percentages
Sheets(StorageSheet).Columns(2).ClearContents

HighestPrice = WorksheetFunction.Max(myRange)
Set Highest = myRange.Find(HighestPrice)
' highlight highest price green
Highest.Font.Color = RGB(0, 255, 0)
' precentage of original price
Highest.Offset(0, 1) = Format(Highest /
Sheets(StorageSheet).Range("A1"), "#.##%")

LowestPrice = WorksheetFunction.Min(myRange)
Set Lowest = myRange.Find(LowestPrice)
' highlight lowest price red
Lowest.Font.Color = RGB(255, 0, 0)
' precentage of original price
Lowest.Offset(0, 1) = Format(Lowest /
Sheets(StorageSheet).Range("A1"), "#.##%")

End If

End Sub

Hope this helps! If so, please click "Yes"