Macro

[Ken]

Listed below is a macro written for an earlier version of Excel. The idea is
to take dynamic values listed in row 1 (specifically cells P1 and R1 to ZA1)
and based on time values listed in column Q (specifically from Q3 to Q392)
show what their value was at the corresponding time. The values fill in rows
3 to 392 as the time (by minutes) is reached. Also, there is an on/off toggle
button in cell A1 which turns the macro on/off. This macro doesn't seem to be
working well with Excel 2007. Please recommend changes that need to be made
to allow the program to work properly in the newer version. Here is the macro
Option Private Module
Option Explicit

Const RANGETIMEVALUES As String = "Q3:Q392"
Const RANGETOCOPYVALUES1 As String = "P1"
Const RANGETOCOPYVALUES2 As String = "R1:ZA1"
Const RANGETOPASTEVALS1 As String = "P0" '0 will be
replaced by row by the macro
Const RANGETOPASTEVALS2 As String = "R0:ZA0" '0 will
be replaced by row by the macro



Sub scheduler(Scheduleit As Boolean)
'Dim maxRow As Long
Dim wsActiveSheet As Worksheet
Set wsActiveSheet = ThisWorkbook.Worksheets("Output")
'maxRow = wsActiveSheet.Range("A65000").End(xlUp).Row
Dim rng As Range
Dim totRange As Range
Set totRange = wsActiveSheet.Range(RANGETIMEVALUES)
If Scheduleit Then
For Each rng In totRange
If Not (rng.Value > 0 And rng.Value <= 1) Then
MsgBox "No valid time at cell " & rng.Address
Else
If rng.Value >= Time() Then
Application.OnTime rng.Value, "Copyvalues"
End If
End If
Next
Else
On Error Resume Next
For Each rng In totRange
If Not (rng.Value > 0 And rng.Value <= 1) Then
MsgBox "No valid time at cell " & rng.Address
Else
Application.OnTime rng.Value, "Copyvalues", , False
End If
Next
End If
End Sub

Sub copyValues()
Dim wsActiveSheet As Worksheet
Set wsActiveSheet = ThisWorkbook.Worksheets("Output")
Dim strTime1 As String
Dim strtime2 As String
Dim rng As Range
Dim totRange As Range
Dim strRangetoPaste As String
Dim tmpArr(0 To 6) As Variant
Set totRange = wsActiveSheet.Range(RANGETIMEVALUES)
strTime1 = Format(Time(), "hh:mm")
Dim lngRow As Long

For Each rng In totRange
If Not (rng.Value > 0 And rng.Value <= 1) Then
MsgBox "No valid time at cell " & rng.Address
Else
strtime2 = Format(rng.Value, "hh:mm")
If strTime1 = strtime2 Then
lngRow = rng.Row
strRangetoPaste = Replace(RANGETOPASTEVALS1, "0", lngRow)
wsActiveSheet.Range(strRangetoPaste).Value =
wsActiveSheet.Range(RANGETOCOPYVALUES1).Value
strRangetoPaste = Replace(RANGETOPASTEVALS2, "0", lngRow)
wsActiveSheet.Range(strRangetoPaste).Value =
wsActiveSheet.Range(RANGETOCOPYVALUES2).Value
End If
End If
Next
End Sub
Sub autpen()
Call scheduler(True)
ThisWorkbook.Worksheets("Output").Range("A1").Value = "Macro Started"
ThisWorkbook.Worksheets("Output").Range("A1").Interior.Color = vbGreen
End Sub
Sub auto_Close()
Call scheduler(False)
ThisWorkbook.Worksheets("Output").Range("A1").Value = "Macro Stopped"
ThisWorkbook.Worksheets("Output").Range("A1").Interior.Color = vbRed
End Sub