ExcelBanter - Macro issue

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Macro issue (https://www.excelbanter.com/excel-programming/390077-macro-issue.html)

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

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

Look at the ontime method

http://www.cpearson.com/excel/ontime.htm

Just put code in the procedure(s) to accomplish the functionality you want.

I guess you could have 10 different initiators that continue to operate at
the specifided intervals. Or keep track of when the next one should run by
managing some type of stack structure.

--
Regards,
Tom Ogilvy

"Dustin" wrote:

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

Man I was way off - thank you very much. I still get a runtime error 13
though. I at least see how it could be done now.
--
Thank you very much

"Bernie Deitrick" wrote:

Dustin,

Oops, I used 4 cells in my testing.

For i = 1 To 4

should be

For i = 1 To 10

in both the Start and the StopMacros macros.

Sorry about that....

Bernie
MS Excel MVP

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
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