PDA

View Full Version : [SOLVED:] Macro for copying the value of one Cell to another cell(s) in specific time interval



Swarnendu
07-15-2017, 12:19 PM
Hi, I am new to this Forum and also in writing Macros.

So, I have managed to write this Macro to copy the value of J2 to K2 and subsequently to L2..M2..N2... where the updated value of J2 is being recorded in subsequent cells at 1 minute's interval.


Sub MntCalculate()
lc = Cells(2, Columns.Count).End(xlToLeft).Column + 1
If lc < 11 Then lc = 11
For i = 0 To 0
Cells(i + 2, lc) = Range("J2")
Next i
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End Sub


My question is, how do I now modify this Macro to also copy the values of J3 to K3..L3..M3..N3.. and J4 to K4..L4..M4..N4... upto J218 to K218..L218..M218..N218... ?

Thanks.

Logit
07-15-2017, 02:19 PM
.
Because the cell references are always the same ( J2 to K2, J3 to K3, etc.) why not use a formula in the cells that will be receiving the data (K2, K3, etc)

In K2 type =IF(J2="","",J2) and press ENTER.

In K3 type =IF(J3="","",J3) and press ENTER.


Do the same for all of the remaining cells.


What the formula is saying : IF cell J3 is empty, then K3 won't display anything. But if J3 does have data it will be displayed in K3.

mdmackillop
07-15-2017, 02:22 PM
Sub MntCalculate()
lc = Cells(2, Columns.Count).End(xlToLeft).Column + 1
If lc < 11 Then lc = 11
lr = Cells(Rows.Count, 10).End(xlUp).Row - 1
With Cells(2, lc).Resize(lr)
.FormulaR1C1 = "=RC10"
.Value = .Value
End With
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End Sub

Swarnendu
07-15-2017, 02:43 PM
.
Because the cell references are always the same ( J2 to K2, J3 to K3, etc.) why not use a formula in the cells that will be receiving the data (K2, K3, etc)

In K2 type =IF(J2="","",J2) and press ENTER.

In K3 type =IF(J3="","",J3) and press ENTER.


Do the same for all of the remaining cells.


What the formula is saying : IF cell J3 is empty, then K3 won't display anything. But if J3 does have data it will be displayed in K3.

My column J keeps changing every minute, and I want to record each minutes data in Columns K to OL. That "IF" formula will just keep changing the value of K whenever the value of J changes.

Anyways, thanks for the suggestion.

Logit
07-15-2017, 02:52 PM
.
Ok ... sounds like there is more to this than was originally posted.

If I understand correctly the first time the copy/paste occurs ... K2 will capture the value of J2.

Then, the next time the copy/paste occurs ... you want L2 to capture the value of J2 ?

Swarnendu
07-16-2017, 07:44 AM
Sub MntCalculate()
lc = Cells(2, Columns.Count).End(xlToLeft).Column + 1
If lc < 11 Then lc = 11
lr = Cells(Rows.Count, 10).End(xlUp).Row - 1
With Cells(2, lc).Resize(lr)
.FormulaR1C1 = "=RC10"
.Value = .Value
End With
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End Sub


Well, I tried something like this:


Sub MntCalculate()
LC = Application.MAX(11, Cells(2, Columns.Count).End(xlToLeft).column + 1)
For i = 2 To 218
Cells(i, LC) = Range("J" & i)
Next i
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End Sub

And, it was working, until I tried to put another one in the "workbook" to make this macro start at 9 AM and end at 3.30 PM every Monday to Friday.


Private Sub Workbook_Open()
If Day(Date) > 1 And Day(Date) < 7 Then
Application.OnTime TimeValue("09:00:00"), _
"Sheet1.MntCalculate", TimeValue("15:30:00")
Else
Application.OnTime TimeValue("09:00:00"), _
"Sheet1.MntCalculate", TimeValue("15:30:00"),,False
End If
End Sub

Now, I am getting an error in the line after "Else" and cursor is highlighting "Ontime" as the culprit.

Help please....

Swarnendu

Swarnendu
07-16-2017, 09:36 AM
.
Ok ... sounds like there is more to this than was originally posted.

If I understand correctly the first time the copy/paste occurs ... K2 will capture the value of J2.

Then, the next time the copy/paste occurs ... you want L2 to capture the value of J2 ?

Maybe I couldn't make it clear in my first post, though I tried. My bad:banghead:, English is my third Language.

And, as you might have noticed from my above post, I now need help for something very different from my first post.

Swarnendu

mdmackillop
07-16-2017, 10:09 AM
Give this a try. Note that I had to make the MntCalculate time prior to the Open time to get this to work.
Test workbook attached.
Note: Your Day function is incorrect, Weekday is required.


Sub MntCalculate()
LC = Application.Max(11, Cells(2, Columns.Count).End(xlToLeft).Column + 1)
For i = 2 To 218
Cells(i, LC) = Range("J" & i)
Next i
If Weekday(Date) <> 1 And Weekday(Date <> 7) Then
If TimeValue(Now) > TimeValue("08:59:00") And TimeValue(Now) < TimeValue("15:30:00") Then
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End If
End If
End Sub




Private Sub Workbook_Open()
If Weekday(Date) <> 1 And Weekday(Date) <> 7 Then
Application.OnTime TimeValue("09:00:00"), "Sheet1.MntCalculate"
End If
End Sub

Logit
07-16-2017, 11:14 AM
.
Swarnendu (http://www.vbaexpress.com/forum/member.php?64473-Swarnendu)

No problem.

Its alot easier to understand the goal from your side because everything is there for you to see.
Sometimes it takes a few exchanges to fully understand what the goal is.

From the workbook mdmackillop (http://www.vbaexpress.com/forum/member.php?87-mdmackillop) posted it is easier to understand the goal. However, I don't understand why the column of data in J changes when it is pasted to the next blank column.
What have I missed ? Shouldn't the data remain the same when it is copied from J and pasted to the next blank column ?

Why is the data changing ?

mdmackillop
07-16-2017, 11:20 AM
Hi Logit
I'm assuming the data is being updated from some Financial website or similar (there are a few such questions) so I can see a logic for the post.
Regards
MD

Swarnendu
07-16-2017, 11:30 AM
Give this a try. Note that I had to make the MntCalculate time prior to the Open time to get this to work.
Test workbook attached.
Note: Your Day function is incorrect, Weekday is required.


Sub MntCalculate()
LC = Application.Max(11, Cells(2, Columns.Count).End(xlToLeft).Column + 1)
For i = 2 To 218
Cells(i, LC) = Range("J" & i)
Next i
If Weekday(Date) <> 1 And Weekday(Date <> 7) Then
If TimeValue(Now) > TimeValue("08:59:00") And TimeValue(Now) < TimeValue("15:30:00") Then
Application.OnTime Now + TimeValue("00:01:00"), "Sheet1.MntCalculate"
End If
End If
End Sub




Private Sub Workbook_Open()
If Weekday(Date) <> 1 And Weekday(Date) <> 7 Then
Application.OnTime TimeValue("09:00:00"), "Sheet1.MntCalculate"
End If
End Sub





Thank you so much!

I don't think there'll be any problem anymore (I have tested it by changing date & time of my PC multiple times, and also the date & time of the codes to test it tonight (Sunday), no problem so far), but I'll get back with the report after running this for a week PLUS a day.

Thanks again...

Swarnendu

Swarnendu
07-16-2017, 11:39 AM
Hi Logit
I'm assuming the data is being updated from some Financial website or similar (there are a few such questions) so I can see a logic for the post.
Regards
MD

You got that right again!!

Actually I'm pulling data from Google Finance via Google Sheet on the cloud to a worksheet on my PC. So, the data keeps changing every minute when the market is open, actually faster than a minute, but my worksheet cannot download it in less than one minute's interval.


Swarnendu

Swarnendu
07-16-2017, 11:52 AM
.

Why is the data changing ?

If you are referring to the Test worksheet attached by mdmackillop, please check the formula in Column "J".
If you meant MY worksheet, well, I have already answered that.


Swarnendu

mdmackillop
07-17-2017, 02:44 AM
I'm pulling data from Google Finance via Google Sheet on the cloud to a worksheet on my PC
If it's public, can you provide details of how you implement this? As I said above, there a a few questions on the subject. Send it by PM if you prefer.

Swarnendu
07-17-2017, 08:57 AM
If it's public, can you provide details of how you implement this? As I said above, there a a few questions on the subject. Send it by PM if you prefer.

Of course i'd want to make the whole process public.

My project is work-in-progress, and I'd welcome as much help as I can get to make it usable. For instant, my auto update has stopped working ever since I macro-enabled the sheet. And, Excel also stops "responding" every now and then.

Before I get into details, bear in mind:

1. I am self-taught in Excel, can work with SOME formulas and manage to find something useful for me.
2. I don't like Google Sheet, so I am not too familiar with it's formulas.
3. I know NOTHING about VBA programming, just started a few day back, but would like to learn.

My Project is to pull Live data of selected stocks from Google Finance into Excel during the working days and hours and create LIVE Sparklines of the LTP (Last Traded Price, which keeps changing constantly while the Market is OPEN.) for the day of each of the Stocks.

(Before going any further please note that Google Finance DOESN'T provide LIVE data of every stock market across the world, and the data can be delayed by even up to 20 minutes in YOUR country, please verify before advancing.)

Now, the problem is that you cannot get live data from Google Finance directly into Excel through the "From Web" button. But, Google Sheet, being a brother, can do that, using a formula called "Googlefinance". It's very easy and you will find everything you want to know about the Syntax in Google Sheet Help. Next, you'll have to make your Google Sheets in Google Drive "Public". And after that, you can use Excel to get data from Google Sheets in the Google Drive, through the "From Web" button, to your Desktop Excel Worksheet.

Here is https://docs.google.com/spreadsheets/d/1nHGbQOiLeyp2UmSxrAMiculf-LTGB0tXQ-nHrtiZEEY/edit#gid=0 one of my Google Sheet (there are 3 of them, because I couldn't download all 218 lines at one go from Sheet to Worksheet, but only one should be enough to understand the process) and my Worksheet is being attached herewith. I'm downloading the data in Sheets 4,5 & 6 from respective Google Sheets, consolidating the data in Sheet3, Sparkline data is in Sheet7 and the final product is in Sheet1. Sheet2 is of no relevance here.

It will be pleasing to know if I have helped any member by providing these files, and any constructive help in improving the project will be highly appreciated.


Swarnendu

Edited to add: Adding any links in Google Sheet cells is a waste of time, the links do not work when the data is pulled to Excel.

mdmackillop
07-17-2017, 09:28 AM
Thanks for that. I have a look at it.

Swarnendu
07-17-2017, 02:41 PM
Thanks for that. I have a look at it.

While you are "at it", could you also do something so that all the previous day's data in the cells from L2 to GY218 at Sheet7 are erased at the beginning of the next workday at 9 AM, so that the next days Sparklines can be started afresh?

Thanks,


Swarnendu

Swarnendu
07-18-2017, 09:20 PM
Latest Update




The Macro "MntCalculate" doesn't start automatically when worksheet opens
"MntCalculate" is filling TWO columns at a time instead of ONE.
Web data isn't updating
The Workbook doesn't AutoCalculate or AutoRefresh


The Macros currently being used:

ThisWorkbook:

Private Sub Workbook_Open()
Application.Calculation = xlCalculationAutomatic
If Weekday(Date) <> 1 And Weekday(Date) <> 7 Then
If TimeValue(Now) > TimeValue("09:14:59") And TimeValue(Now) < TimeValue("15:30:01") Then
Application.OnTime Now + TimeValue("00:00:01"), "Sheet7.MntCalculate"
End If
End If
End Sub

Sheet7:

Sub MntCalculate()
Application.Calculation = xlCalculationManual
LC = Application.Max(11, Cells(2, Columns.Count).End(xlToLeft).Column + 1)
For i = 2 To 218
Cells(i, LC) = Range("J" & i)
Next i
Application.Calculation = xlCalculationAutomatic
If Weekday(Date) <> 1 And Weekday(Date <> 7) Then
If TimeValue(Now) > TimeValue("09:14:59") And TimeValue(Now) < TimeValue("15:30:01") Then
Application.OnTime Now + TimeValue("00:02:00"), "Sheet7.MntCalculate"
End If
End If
End Sub

I have also attached the latest Worksheet


Swarnendu

Swarnendu
07-19-2017, 03:14 PM
Well, these are my latest Macros, and everything seems to be working fine:

Workbook:

Private Sub Workbook_Open()
If Weekday(Date) <> 1 And Weekday(Date) <> 7 Then
Application.OnTime Now, "Sheet7.MntCalculate"
End If
End Sub

Sheet7:

Sub MntCalculate()
If TimeValue(Now) > TimeValue("08:55:00") And TimeValue(Now) < TimeValue("09:15:00") Then
Range("L2:NW218").ClearContents
Application.OnTime Now + TimeValue("00:00:01"), "Sheet7.MntCalculate"
Else
If TimeValue(Now) > TimeValue("09:14:59") And TimeValue(Now) < TimeValue("15:30:01") Then
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.RefreshAll
LC = Application.Max(11, Cells(2, Columns.Count).End(xlToLeft).Column + 1)
For i = 2 To 218
Cells(i, LC) = Range("J" & i)
Next i
Application.OnTime Now + TimeValue("00:01:00"), "Sheet7.MntCalculate"
Else
Application.OnTime Now + TimeValue("00:00:01"), "Sheet7.MntCalculate"
End If
End If
End Sub





Thank you mdmackillop (http://www.vbaexpress.com/forum/member.php?87-mdmackillop) for all the help you provided.

I'll come back to start another thread if I still face any problems with the codes.

Swarnendu

mdmackillop
07-19-2017, 03:40 PM
I had a look at this earlier; simplified things a bit. I've deleted 9 data connections leaving one live one. Instead of using the built in 1 minute refresh, I've added a 30 second refresh in Module 1 to ensure things are current. The time is added to Row 1 with each update. I've added conditional formatting to highlight changes (for debug) The WB Open has been tweaked to make the starup less confusing. Sheet7 macro has the formula simplified and removes Calculation settings.

Swarnendu
07-19-2017, 03:50 PM
OK, I'll have a look at it

tirth2212
12-17-2020, 01:00 PM
I had a look at this earlier; simplified things a bit. I've deleted 9 data connections leaving one live one. Instead of using the built in 1 minute refresh, I've added a 30 second refresh in Module 1 to ensure things are current. The time is added to Row 1 with each update. I've added conditional formatting to highlight changes (for debug) The WB Open has been tweaked to make the starup less confusing. Sheet7 macro has the formula simplified and removes Calculation settings.
Can you Send the excel again? I am having issues running it