Code help please

[knot]

I am using the following formula to place -3 in cell Q2 to refresh the quick pick list at 11.30am, =IF(AND(X2>0.46875,X2<0.469444),-3,2). Cell X2 is the time in decimal format. The formula works well but when -3 is placed in Q2 the formula is deleted. Can i get around this using vba? Im hopless with vba/code ect, any help please?

[throwmeadisc]

Hey knot,

Just knocked up this code for you. Should hopefully do the job.

Notes: It assumes that your connected Excel Sheet is 'Sheet1' and also uses 'AA1' to record the scheduled time that the refresh will happen. If you try and close the Workbook but then cancel, the scheduled refresh will not happen. To re-enable it - Run the Macro: SetupPicklistRefresh.

Code: Select all

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim RunTime As Date
RunTime = ThisWorkbook.Sheets("Sheet1").Range("AA1").Value
On Error Resume Next
Application.OnTime RunTime, "RefreshPickList", , False
ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = ""
End Sub

Private Sub Workbook_Open()
Call SetupPicklistRefresh
End Sub

Sub RefreshPickList()
Dim RunTime As Date

ThisWorkbook.Sheets("Sheet1").Range("Q2").Value = -3
RunTime = Date + 1 + TimeValue("11:30")
Application.OnTime RunTime, "RefreshPickList", , True
ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = RunTime
End Sub

Sub SetupPicklistRefresh()
Dim RunTime As Date
   
With ThisWorkbook.Sheets("Sheet1").Range("AA1")
    If .Value <> "" Then Application.OnTime .Value, "RefreshPickList", , False
End With
   
RunTime = Date + TimeValue("11:30")
If Now > RunTime Then
    RunTime = Date + 1 + TimeValue("11:30")
    ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = RunTime
End If
Application.OnTime RunTime, "RefreshPickList", , True
End Sub


In the VBA editor put this under "ThisWorkBook"

Cheers,

Al

[knot]

thanks for the time and effort throwmeadisc didnt realize there would would be so much to it ill give it a go, cheers.

[throwmeadisc]

No worries mate. Suppose it could have been simpler, but I like the Application.Ontime Method as it saves a few CPU clock cycles as you don't havre to keep checking if it's the right time to run something or not.

But with it you need to handle it correctly as sometimes if you don't disable the scheduled item when the workbook is closed, it will re-open it and run the procedure!!

http://www.ozgrid.com/Excel/run-macro-on-time.htm

Anyway, hope it works for you.

Al

[throwmeadisc]

Opps...

Just spotted a slight mistake...

New Code:

Code: Select all

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim RunTime As Date
RunTime = ThisWorkbook.Sheets("Sheet1").Range("AA1").Value
On Error Resume Next
Application.OnTime RunTime, "RefreshPickList", , False
ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = ""
End Sub

Private Sub Workbook_Open()
Call SetupPicklistRefresh
End Sub

Sub RefreshPickList()
Dim RunTime As Date

ThisWorkbook.Sheets("Sheet1").Range("Q2").Value = -3
RunTime = Date + 1 + TimeValue("11:30")
Application.OnTime RunTime, "RefreshPickList", , True
ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = RunTime
End Sub

Sub SetupPicklistRefresh()
Dim RunTime As Date
   
With ThisWorkbook.Sheets("Sheet1").Range("AA1")
    If .Value <> "" Then Application.OnTime .Value, "RefreshPickList", , False
End With
   
RunTime = Date + TimeValue("11:30")
If Now > RunTime Then RunTime = Date + 1 + TimeValue("11:30")

ThisWorkbook.Sheets("Sheet1").Range("AA1").Value = RunTime
Application.OnTime RunTime, "RefreshPickList", , True
End Sub


Changes were made in the Sub SetupPicklistRefresh() section at the bottom.

Sorry mate......

Al

[Steve Voltage]

ive modified this code to work on a sheet called 19 at the time of 12:50:00 butnothing happens any ideas please.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim RunTime As Date
RunTime = ThisWorkbook.Sheets("19").Range("AA1").Value
On Error Resume Next
Application.OnTime RunTime, "RefreshPickList", , False
ThisWorkbook.Sheets("19").Range("AA1").Value = ""
End Sub

Private Sub Workbook_Open()
Call SetupPicklistRefresh
End Sub

Sub RefreshPickList()
Dim RunTime As Date

ThisWorkbook.Sheets("19").Range("Q2").Value = -3
RunTime = Date + 1 + TimeValue("12:50:00")
Application.OnTime RunTime, "RefreshPickList", , True
ThisWorkbook.Sheets("19").Range("AA1").Value = RunTime
End Sub

Sub SetupPicklistRefresh()
Dim RunTime As Date

With ThisWorkbook.Sheets("19").Range("AA1")
If .Value <> "" Then Application.OnTime .Value, "RefreshPickList", , False
End With

RunTime = Date + TimeValue("12:50:00")
If Now > RunTime Then RunTime = Date + 1 + TimeValue("12:50:00")

ThisWorkbook.Sheets("19").Range("AA1").Value = RunTime
Application.OnTime RunTime, "RefreshPickList", , True
End Sub

[jokerjoe]

This is based my approach, the if clause is to make sure it doesn't run unnecessarily if you've already refreshed during the day.

Code: Select all

Private Sub Workbook_Open()
    Call Tempo_Market
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnTime earliesttime:=vartimer_market, procedure:="Tempo_Market", schedule:=False
End Sub


Public vartimer_market As Date

Sub Tempo_Market()
    vartimer_market = Date + 1 + TimeSerial(0, 12, 50)
    If Date > wsSM.Range("B3").Value Then
        wsBA.Range("Q2") = -3
        wsSM.Range("B3").Value = Date + Time
        Application.OnTime TimeValue(vartimer_market), "Tempo_Market"
    Else
        Application.OnTime TimeValue(vartimer_market), "Tempo_Market"
    End If
End Sub


[throwmeadisc]

Hi,

Are you sure you did this bit correctly....

In the VBA editor put this under "ThisWorkBook"

Al