build a list with timestamps

[steve0725]

Hi,

On one worksheet (Sheet1) I have a named range ("SumDaily") which is
pulling data from an outside source that updates automatically. I
would like to capture this data once every minute, paste as values
(transposed) on Sheet3 with a time stamp. I want to append it each
time to the bottom of the list so that at the end of a 6.5 hour period
I have 390 rows of data with respective timestamps (Row 1 has headers,
Column A would be time stamp).

Below is a recorded version of how I would do it for one line, but I
don't know how to append it to the bottom of a list, nor do I know how
to make it run automatically every 60 seconds (relative beginner with
VBA). I'm using Excel 2007, Windows XP.

Sub Macro1()

'Ideally I don't want it to activate the workbook since I want to be
working in other applications or other workbooks while it runs

Windows("MyWorkbook.xlsx").Activate
Sheets("Sheet1").Select
Application.Goto Reference:="SumDaily"
Selection.Copy
Sheets("Sheet3").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=True
Range("A2").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

A bonus would be to make it run only during market hours (9:30 AM -
4:00 PM), but this isn't necessary since I can just open and close the
workbook at those times.

Many thanks!
Steve

 

[Joel]

Sub GetData()

'Ideally I don't want it to activate the workbook since I want to be
'working in other applications or other workbooks while it runs

MyTime = Time

If MyTime >= TimeValue("6:30AM") And _
MyTime <= TimeValue("4:00PM") Then

With ThisWorkbook
Range("SumDaily").Copy
'Application.CutCopyMode = False
With .Sheets("Sheet3")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
.Range("B" & NewRow).PasteSpecial _
Paste:=xlPasteValues, _
Transpose:=True
.Range("A" & NewRow) = MyTime
End With
End With
End If
Application.OnTime Now + TimeValue("00:01:00"), "GetData"

End Sub

 

[steve0725]

Works great!!! Thanks.

One question...the time stamp includes a date (1/0/1900), depending on
how I format it. Is there a way to include today's date with the
time?

Thank you
Steve

 

[Joel]

I made 3 changes

1) Added Date to MyTime when saving data to worksheet
.Range("A" & NewRow) = MyTime + Date

Date is the midnight time and Mytime is only the hours, minutes and seconds.

2) Changed Start time to 9:30. For testing I was using 6:30 and forgot to
change the time before posting
3) I changed the end time to <4:01PM so the 4:00PM time gets posted.
Otherwise the last posting would be 3:59PM.


Note:
You can add a workbook open event to automactically start the macro. Put
this code in the Thisworkbook VBA sheet.

Private Sub Workbook_Open()
Call GetData
End Sub



Sub GetData()

'Ideally I don't want it to activate the workbook since I want to be
'working in other applications or other workbooks while it runs


If MyTime >= TimeValue("9:30AM") And _
MyTime < TimeValue("4:01PM") Then

With ThisWorkbook
Range("SumDaily").Copy
'Application.CutCopyMode = False
With .Sheets("Sheet3")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1
.Range("B" & NewRow).PasteSpecial _
Paste:=xlPasteValues, _
Transpose:=True
.Range("A" & NewRow) = MyTime + Date
End With
End With
End If
Application.OnTime Now + TimeValue("00:01:00"), "GetData"

End Sub

 

[steve0725]

Thanks, Joel. Appreciate the changes. One question...if I'm working
in another workbook while this is running in the background, it gives
me an error. I assume it's because of the "ThisWorkbook" code. Any
thoughts on how to get around this?

Thanks
Steve

 

[Joel]

I got an e-mail this afternoon indicating there was a new posting, yet when I
looked there is no message.

 

[steve0725]

Thanks, Joel.  Appreciate the changes.  One question...if I'm working
in another workbook while this is running in the background, it gives
me an error.  I assume it's because of the "ThisWorkbook" code.  Any
thoughts on how to get around this?

Thanks
Steve

See above. I get an error if I'm working in another workbook.
Thanks
Steve

 

[Joel]

This website has been down since the evening of the 23rd. Just came back up
this morning.

You can always set the workbook by using a variable like

from
with thisworkbook

to
Set Bk = activeworkbook
with BK

or specifically calling out the workbook name

Set Bk = workbooks("book1.xls")
with BK