Macro thats runs every minute is copying too much data

[rhudgins]

I have the following code that is supposed to copy data once every 30 seconds throughout the day. Every 30 seconds the RunEveryXMinute code is copying data two or three times instead of just once. Can anyone explain why this is happening?

Option Explicit
Dim icount As Integer, Inumber As Integer, rStart As Range

Sub CopyLiveTradeData()
    Application.OnTime TimeValue("09:34:00"), "StartOnTime"
End Sub

Private Sub StartOnTime()
    icount = 0
    Inumber = 1000
    Workbooks("historical data run (thomson)_live").Worksheets("Live Data").Select
    Call OnTimeMacro
End Sub
Private Sub OnTimeMacro()
    If icount <= Inumber Then
        icount = icount + 1
        Application.OnTime Now + TimeValue("00:00:30"), "RunEveryXMinute"
    Else
        Workbooks("historical data run (thomson)_live").Worksheets("Live Data").Select
    End If
End Sub

Private Sub RunEveryXMinute()

    Dim rDate As Range
    Dim dt As Date
    Dim rCopyFrom As Range
    Dim rCopyTo As Range
    Dim rTrade As Range
    Dim sh As Worksheet
    Dim iRowsToSkip As Integer

    iRowsToSkip = 27
    Set sh = Workbooks("historical data run (thomson)_live").Worksheets("Live Data")

    With sh
        Set rDate = .Range("N1")
        dt = rDate.Value
        Set rCopyFrom = .Range("O59").Resize(1, 2)
        Set rTrade = .Range("T79")

        On Error GoTo EF
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Do While rCopyFrom.Cells(1, 1).Value <> ""
            Set rCopyTo = rTrade
            If rCopyTo.Value <> "" Then
                If rCopyTo.Offset(0, 1).Value <> "" Then
                    Set rCopyTo = rCopyTo.End(xlToRight)
                End If
                Set rCopyTo = rCopyTo.Offset(0, 1)
            End If

            Set rCopyTo = rCopyTo.Resize(3, 1)
            With rCopyTo.Cells(1, 1)
                rDate.Copy        'for format
                .Value = dt
                .PasteSpecial Paste:=xlPasteFormats, Operation:= _
                        xlNone, SkipBlanks:=False, Transpose:=False
            End With

            rCopyFrom.Cells(1, 1).Copy
            rCopyTo.Cells(2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False

            rCopyFrom.Cells(1, 2).Copy
            rCopyTo.Cells(3, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
                    xlNone, SkipBlanks:=False, Transpose:=False

            With rCopyTo.Font
                .ThemeColor = xlThemeColorDark1
                .ColorIndex = 2
                .TintAndShade = 0
            End With

            Set rCopyFrom = rCopyFrom.Offset(iRowsToSkip, 0)
            Set rTrade = rTrade.Offset(iRowsToSkip, 0)
        Loop
    End With

    Call OnTimeMacro
EF:
    Application.EnableEvents = True
End Sub

[venkat1926]

a guess

Is not 30 seconds very short time for running the macro.the macro probably takes more than 30 seconds to run. so some things are repeated. Make the frequency one or two minutes and check or time the macro running and then adjust the frequency