Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro
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 auto_Open() Call scheduler(True) ThisWorkbook.Worksheets("Output").Range("A1").Valu e = "Macro Started" ThisWorkbook.Worksheets("Output").Range("A1").Inte rior.Color = vbGreen End Sub Sub auto_Close() Call scheduler(False) ThisWorkbook.Worksheets("Output").Range("A1").Valu e = "Macro Stopped" ThisWorkbook.Worksheets("Output").Range("A1").Inte rior.Color = vbRed End Sub -- Ken |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort | Excel Worksheet Functions | |||
My excel macro recorder no longer shows up when recording macro | Excel Discussion (Misc queries) | |||
using a cell value to control a counter inside a macro and displaying macro value | Excel Worksheet Functions | |||
Macro needed to Paste Values and prevent Macro operation | Excel Discussion (Misc queries) | |||
Macro needed to Paste Values and prevent Macro operation | Excel Discussion (Misc queries) |