PDA

View Full Version : [SOLVED:] Copy&paste only if live value has changed from previous loop



RINCONPAUL
07-05-2016, 04:02 PM
With reference to attached, I have a range (A2:G2) on sheet "Copy", that is continually refreshing every second by 3rd party software. A loop macro copies and pastes that range to sheet "Paste" every second in next blank row of Excel Table. However, there are often periods where the Vol variable (col G) doesn't change, so the information is repeated.

My macro attempts to only copy&paste if the current cell G2 on sheet "Copy" is different from the last paste value in col G in the table on sheet "Paste", but isn't working. Where have I gone wrong?


Dim TimeToRun
Sub StartTimer()
Call ScheduleCopy_Race
End Sub
Sub Copy_Race()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Copy")
Set pasteSheet = Worksheets("Paste")
If pasteSheet.Range("G3").End(xlDown) <> copySheet.Range("G3") Then
copySheet.Range("A2:G2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
StartTimer
End If
End Sub
Sub ScheduleCopy_Race()
TimeToRun = Now + TimeValue("00:00:02")
Application.OnTime TimeToRun, "Copy_Race"
End Sub
Sub StopTimer()
Application.OnTime TimeToRun, "Copy_Race", , False
End Sub

SamT
07-05-2016, 05:59 PM
See if this works

Sub Copy_Race()
Static LastValue As ??? 'Long? String? Double? 'What is G3?
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet

Set copySheet = Worksheets("Copy")
Set pasteSheet = Worksheets("Paste")

If copySheet.Range("G3") <> LastValue Then
LastValue = copySheet.Range("G3").Value
copySheet.Range("A2:G2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
StartTimer
End If
End Sub

RINCONPAUL
07-05-2016, 06:15 PM
Sam, "G3" is a number, so I've inserted "Static LastValue As Integer", in your code but it doesn't work? Not sure if this is correct or not?
Cheers

SamT
07-05-2016, 06:18 PM
This might be faster Since most range variables will only be set once per book opening

Sub Copy_Race()
Static LastValue As ??? 'Long? String? Double? 'What is G3?
Static G3 As Range
Static A2G2 As Range
Static PasteCell As Range

With Worksheets("Copy")
Set G3 = .Range("G3")
Set A2G2 = .Range("A2:G2")
End With

Set PasteCell = Worksheets("Paste").Cells(Rows.Count, 1).End(xlUp).Offset(1)


If G3.Value <> LastValue Then
LastValue = G3.Value

A2G2.Copy
PasteCell.PasteSpecial xlPasteValues
Set PasteCell = PasteCell.Offset(1)

StartTimer
End If
End Sub

RINCONPAUL
07-05-2016, 06:30 PM
I assume your desktop is still busted Sam, or you don't want to open the file? No it still doesn't work. It doesn't throw an error either, just mute.
The code I put in as you still had your comments on the 2nd reply:



Sub Copy_Race()
Static LastValue As Integer
Static G3 As Range
Static A2G2 As Range
Static PasteCell As Range

With Worksheets("Copy")
Set G3 = .Range("G3")
Set A2G2 = .Range("A2:G2")
End With

Set PasteCell = Worksheets("Paste").Cells(Rows.Count, 1).End(xlUp).Offset(1)


If G3.Value <> LastValue Then
LastValue = G3.Value

A2G2.Copy
PasteCell.PasteSpecial xlPasteValues
Set PasteCell = PasteCell.Offset(1)

StartTimer


End If
End Sub

SamT
07-05-2016, 06:46 PM
MsgBox "Checking G3, ready to enter IF statement"
If G3.Value <> LastValue Then
LastValue = G3.Value
MsgBox "Inside If statement now"

RINCONPAUL
07-05-2016, 07:08 PM
The Msg Box comes up but the macro hangs

RINCONPAUL
07-06-2016, 03:18 AM
I solved it!


Sub Copy_Race()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Copy")
Set pasteSheet = Worksheets("Paste")
If (Not (pasteSheet.Range("G3").End(xlDown) = copySheet.Range("G3"))) Then Exit Sub Else
copySheet.Range("A2:G2").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
StartTimer


End Sub