Dustin,

Try the macros below. Run "Start" to begin, and "StopMacros" to end...

HTH,
Bernie
MS Excel MVP


Option Explicit
Dim NextTime(1 To 10) As Date

Sub Start()
Dim i As Integer
For i = 1 To 4
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
Next i
End Sub


Sub MoveCell1()
Dim myCell As Range
Dim i As Integer

i = 1
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.Value = Format(Now(), "hh:mm:ss")
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell2()
Dim myCell As Range
Dim i As Integer

i = 2
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell3()
Dim myCell As Range
Dim i As Integer

i = 3
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell4()
Dim myCell As Range
Dim i As Integer

i = 4
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell5()
Dim myCell As Range
Dim i As Integer

i = 5
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell6()
Dim myCell As Range
Dim i As Integer

i = 6
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell7()
Dim myCell As Range
Dim i As Integer

i = 7
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell8()
Dim myCell As Range
Dim i As Integer

i = 8
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub MoveCell9()
Dim myCell As Range
Dim i As Integer

i = 9
Set myCell = Range("D" & i)
myCell.Offset(1, 0).Value = myCell.Value
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub



Sub MoveCell10()
Dim myCell As Range
Dim i As Integer

i = 10
Set myCell = Range("D" & i)
myCell.ClearContents
NextTime(i) = Now() + TimeValue("00:00:60") - (i - 1) * TimeValue("00:00:02")
Application.OnTime NextTime(i), "MoveCell" & i
End Sub


Sub StopMacros()
Dim i As Integer
For i = 1 To 4
Application.OnTime NextTime(i), "MoveCell" & i, schedule:=False
Next i

End Sub


"Dustin" wrote in message
...
I am trying to write a macro that will move the values of cells within a
column down a cell at differnt intervals - every 60 seconds move D1 to D2,
every 58 second move D2 to D3, every 56 seconds move D3 to D4, and so on
(fall down) with the last one (D10) being cleared out every 42 seconds.
Needless to say I am having some difficulty doing so. Any help would be
greatly appreciated.
--
Thank you very much