PDA

View Full Version : Simple computation to record the difference between consecutive cells over a range



Jayyunit
01-12-2016, 07:49 PM
Hi Guys!




I have a functioning macro that copy pastes the static values of live data from the live data sheet (Sheet), onto a separate sheet (Sheet2) every second. The code is below. For your information, Range("B2:B2195") are stock codes while Range("H2:H2195") are stock quotes.


Sub copypaste_RECENT()
Dim ab As Integer

Worksheets("Sheet").Range("B2:B2195").Copy

With Sheets("Sheet2")
.Range("B1").PasteSpecial Transpose:=True
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now

Worksheets("Sheet").Range("H2:H2195").Copy
.Range("B" & ab).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End With

Application.OnTime Now + TimeSerial(0, 0, 1), "copypaste_RECENT"
End Sub


My next step is one that im having trouble with. I would like to record the difference between the stock quotes. This is a simple computation that calculates the difference between a certain cell and the cell above it and records this value onto a separate sheet (Sheet3). This computation is done for every cell in the range. This would run simultaneously to the code above so I've tried to include an additional code after End With and before the Application. The code is below.


Worksheets("Sheet").Range("B2:B2195").Copy

With Sheets("Sheet3")
.Range("B1").PasteSpecial Transpose:=True

Dim xy As Long, yz As Long
ab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
bc = .Cells(1, .Columns.Count).End(x1toleft).Column + 1
.Cells(1, 1).Value = "Time"
.Cells(ab, 1).Value = Now

xy = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row
yz = Worksheets("Sheet2").Cells(.Rows.Count, 1).End(x1up).Row.Offset(-1, 0)

For ab = 1 To Cells(Rows.Count, 1).End(x1up).Row + 1
For bc = 1 To Cells(1, Columns.Count).End(x1toleft).Column + 1
.Cells(ab, bc).Value = xy - yz
Next ab
Next bc
End With

I'm quite new to VBA and I know this is completely wrong. I've been struggling for a while but I hope it makes some sort of sense.

Thanks in advance!

Grant

SamT
01-12-2016, 10:29 PM
See what you make of this

Option Explicit

Sub copypaste_RECENT()
Dim Record As Worksheet
Dim Accumulate As Worksheet

Set Record = Sheets("Sheet2")
Set Accumulate = Sheets("Sheet3")

If Record.Cells(1) = "" Then 'This is the first time this sub has run

'Copy and paste the Stock Codes
Worksheets("Sheet").Range("B2:B2195").Copy
Record.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Accumulate.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True

'Copy and paste the first Stock Quotes
Worksheets("Sheet").Range("H2:H2195").Copy
Record.Range("B2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Accumulate.Range("B2").PasteSpecial Paste:=xlPasteValues, Transpose:=True
'Set up the next row for addition
Accumulate.Range("B3").PasteSpecial Paste:=xlPasteValues, Transpose:=True

'Finish first two cells in Column A
Record.Range("A1") = "Time"
Record.Range("A2") = Now
Accumulate.Range("A1") = "Time"
Accumulate.Range("A2") = Now

Exit Sub 'Done with the first time thru
End If

Worksheets("Sheet").Range("H2:H2195").Copy
'Log these Stock Quotes
Record.Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True

'Add to the last existing row
Accumulate.Cells(Rows.Count, 2).End(xlUp).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationAdd, Transpose:=True
'Set up the next Row for addition
Accumulate.Cells(Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Application.CutCopyMode = False 'clear the clipboard

'log the time(s)
Accumulate.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Now
Record.Cells(Rows.Count, 1).End(xlUp).Offset(1) = Now

Application.OnTime Now + TimeSerial(0, 0, 1), "copypaste_RECENT"
End Sub

This code is on a timer. I'll bet you have other code on a different timer. They will interfere with each other. You should make one code the the "Master Of All Time," and have it Call the others when it is ready for them

Jayyunit
01-12-2016, 11:54 PM
Hey SamT,

Thanks a lot for replying!

The first part recording the codes and quotes onto Sheet2 works!

Sorry! I don't think i made my intentions clear for Sheet3 though. I think what i need is something like this.

For example on Sheet3:



B2=Sheet2!B3-Sheet2!B2
B3=Sheet2!B4-Sheet2!B3
C2=Sheet2!C3-Sheet2!C2
C3=Sheet2!C4-Sheet2!C3


and so on... for the range H2:H2195.
I'm not sure how to combine special mathematical functions with VBA coding.

Also, I understand if I have two different macros they will probably interfere with each other. I'm thinking to make this all into one macro so that they run simultaneously.

snb
01-13-2016, 01:59 AM
Why no using the simplest Excelformula in column H ?

SamT
01-13-2016, 05:43 AM
Change xlPasteSpecialOperationAdd to xlPasteSpecialOperationSubtract

BTW, If you place the cursor inside the keyword PasteSpecial and press F1, the help will show you that.

Or you can do like snb suggested and have column I = H*-1. Then copy and paste H then copy and paste I with special operation Add. There are at least a Bakers Dozen ways to do it. Try several and see which one is fastest for you.


I'm thinking to make this all into one macro so that they run simultaneously.
IMO, it is better to have separate Procedures and have one Timed Procedure call the rest. Just use a DoEvents before calling the next procedure.