Excel Automated...

[mak]

hi,
i have Gary's code to autoupdate quickpick list every morning which it works fine.

--------------------------------------------------------------------------
Option Explicit

Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub

-----------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = 16 Then
Application.EnableEvents = False
If triggerQuickPickListReload Then
triggerQuickPickListReload = False
Range("Q2").Value = -3.1
triggerFirstMarketSelect = True
Else
If triggerFirstMarketSelect Then
triggerFirstMarketSelect = False
Range("Q2").Value = -5
End If
End If
Application.EnableEvents = True
End If
End Sub



Public triggerQuickPickListReload As Boolean
Public triggerFirstMarketSelect As Boolean

Public Sub loadQuickPickList()
triggerQuickPickListReload = True
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


----------------------------------------------------------------------------------

I also have the following macros to populate -1 at q2 every x seconds

Public RunWhen As Date
Public Const cRunIntervalSeconds = 20 'adjust to the time you wish
Public Const cRunWhat = "TheSub"


Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub


Sub TheSub()

Cells(2, 17).Value = -1

StartTimer ' Reschedule the procedure
End Sub


What i need and I can't seem to make it work is to

1.Enable the "Start Timer" macro automatically when i open the workbook
2.Begin the "Start Timer" if d2 in excel is less than 20 minutes (00:20:00).

3.Rearrange the code in order to have multiple workbooks open ( i think this is easier)

Can someone point to the right direction please?

[osknows]

Hello,

1.Enable the "Start Timer" macro automatically when i open the workbook

Just add the StartTimer to the Workbook open event

Code: Select all

Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
StartTimer ' Reschedule the procedure
End Sub


2.Begin the "Start Timer" if d2 in excel is less than 20 minutes (00:20:00).

Is this needed? If the timer starts on workbook open and resets itself every 20 seconds then this test isn't required.

3.Rearrange the code in order to have multiple workbooks open ( i think this is easier)

Code: Select all

Option Explicit

Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
StartTimer ' Reschedule the procedure
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Columns.Count = 16 Then
Application.EnableEvents = False
If triggerQuickPickListReload Then
triggerQuickPickListReload = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -3.1
triggerFirstMarketSelect = True
Else
If triggerFirstMarketSelect Then
triggerFirstMarketSelect = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -5
End If
End If
Application.EnableEvents = True
End If
End Sub



Public triggerQuickPickListReload As Boolean
Public triggerFirstMarketSelect As Boolean

Public Sub loadQuickPickList()
triggerQuickPickListReload = True
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


---------------
Public RunWhen As Date
Public Const cRunIntervalSeconds = 20 'adjust to the time you wish
Public Const cRunWhat = "TheSub"


Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
Schedule:=True
End Sub


Sub TheSub()
Application.EnableEvents = False
Dim ws As Worksheet

For Each ws In Worksheets
If Left(LCase(ws.Name), 6) = "market" Then
    ws.Cells(2, 17).Value = -1
End If
Next

StartTimer ' Reschedule the procedure
Application.EnableEvents = True
End Sub


The If Left(LCase(ws.Name), 6) = "market" checks to see if the first 6 characters of each worksheet is named "market" and will place -1. This will ensure -1 is only placed in market worksheets and not results. You may need to alter this to reflect your naming convention.

[mak]

Os hi,
thanks for your help

regarding timing (No 2) I really need the code to actually begin to run if d2 is less than 20 minutes ( I was suppose to change the rest of the code to run every 20 minutes). I need the bot to "check" the market 20 (or x ) minutes before the each race start. Right now I work with BA autoselect markets fiction but when 2 races start at excactly the same time the bot miss one of them.

regarding If Left(LCase(ws.Name), 6) = "market"
if i have for example 3 bots market1 market2 & market3 if i change accordingly the names in the macros will be ok?

[osknows]

At the moment the timer starts when the workbook opens and every 20 seconds places -1 in all worksheets beginning with "market"

Is what you want a macro that monitors each worksheet individually, and if the time in d2 is less than 20mins then place -1 in that worksheet only every 20 seconds? What about if the market goes in play?

I'll have a look when I get home tonight
Os

[mak]

'' Is what you want a macro that monitors each worksheet individually, and if the time in d2 is less than 20mins then place -1 in that worksheet only every 20 minutes? "

I need the macro to place -1 every 20 minutes, but to actaully start 20 minutes before the first race of the day.

If this can be done without the macro start when the workbook open i wouldn't mind...I asked about it just because as the macro was in first place i had to run the start macro manually once every day.

" What about if the market goes in play? ''
I don't care if the market goes in play, the bot will be at other markets...

thanks for your time Os

[osknows]

I haven't tested this with BA but I think it should work ok

Put this is in each SHEET object and delete the earlier MODULE

Code: Select all

Option Explicit

Public triggerQuickPickListReload As Boolean
Public triggerFirstMarketSelect As Boolean
Public lastrace As String
Public eventtriggertimer As Date
Const triggerduration As Integer = 20 'trigger every 20 minutes
Const timebeforeevent As Integer = 20 'monitor event only 20 minutes before start


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count = 16 Then
Application.EnableEvents = False

'reset timer on event change
If lastrace <> ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value Then
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
        lastrace = ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value
        Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End If

'check if time is in play & negative
If InStr(1, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value, "-", vbTextCompare) = 1 Then

     If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
        ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
     End If

Else

'check for 25 minutes before first event
    If DateDiff("s", 0, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value) <= timebeforeevent * 60 Then
   
         If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
            ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
            eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
         End If
    End If

End If

If triggerQuickPickListReload Then
triggerQuickPickListReload = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -3.1
triggerFirstMarketSelect = True
Else
If triggerFirstMarketSelect Then
triggerFirstMarketSelect = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -5
End If
End If



Application.EnableEvents = True
End If
End Sub

Private Sub loadQuickPickList()
triggerQuickPickListReload = True
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


the trigger duration and time before start event can be changed in the constants

[mak]

Many Thanks Os!
I will test it later at home & let you know

you have been great help for me and the forum
hope to be able & return the favor somehow

[osknows]

Why do you always think of something obvious after you post??

I don't think the above code will work as the Ontime event needs to call to a MODULE..try this instead

Code: Select all

Option Explicit
Public triggerQuickPickListReload As Boolean
Public triggerFirstMarketSelect As Boolean

Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


Public Sub loadQuickPickList()
triggerQuickPickListReload = True
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub



and this in each SHEET

Code: Select all

Option Explicit


Public lastrace As String
Public eventtriggertimer As Date
Dim ws As Worksheet
Const triggerduration As Integer = 20 'trigger every 20 minutes
Const timebeforeevent As Integer = 20 'monitor event only 20 minutes before start


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.Count = 16 Then
Application.EnableEvents = False

'reset timer on event change
If lastrace <> ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value Then
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
        lastrace = ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value
End If

'check if time is in play & negative
If InStr(1, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value, "-", vbTextCompare) = 1 Then

     If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
        ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
     End If

Else

'check for 20 minutes before first event
    If DateDiff("s", 0, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value) <= timebeforeevent * 60 Then
   
         If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
            ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
            eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
         End If
    End If

End If

If triggerQuickPickListReload Then
triggerQuickPickListReload = False
    For Each ws In Worksheets
    If Left(LCase(ws.Name), 6) = "market" Then
        ws.Range("Q2").Value = -3.1
    End If
    Next

triggerFirstMarketSelect = True
Else
If triggerFirstMarketSelect Then
triggerFirstMarketSelect = False
    For Each ws In Worksheets
    If Left(LCase(ws.Name), 6) = "market" Then
        ws.Range("Q2").Value = -3.1
    End If
    Next
End If
End If



Application.EnableEvents = True
End If
End Sub


ensure all sheets are name with the word market (lower/upper or mixed case) as the first 6 letters

[osknows]

and replace the last ws.Range("Q2").Value = -3.1
with ws.Range("Q2").Value = -5


doh

[osknows]

I'm really sorry but I keep thinking of reasons why my code won't work.

I'm sure this one definitely will though and is better than the previous attempts
this in a MODULE

Code: Select all

Option Explicit
'set to number of worksheets in workbook
Public triggerQuickPickListReload(1 To 10)  As Boolean
Public triggerFirstMarketSelect(1 To 10) As Boolean


Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


Public Sub loadQuickPickList()
Dim count_array As Integer

For count_array = 1 To UBound(triggerQuickPickListReload)
triggerQuickPickListReload(count_array) = True
Next

Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub



and this in the SHEET

Code: Select all

Option Explicit


Public lastrace As String
Public eventtriggertimer As Date
Dim ws As Worksheet
Const triggerduration As Integer = 20 'trigger every 20 minutes
Const timebeforeevent As Integer = 20 'monitor event only 20 minutes before start


Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Columns.count = 16 Then
Application.EnableEvents = False

'reset timer on event change
If lastrace <> ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value Then
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
        lastrace = ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value
End If

'check if time is in play & negative
If InStr(1, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value, "-", vbTextCompare) = 1 Then

     If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
        ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
     End If

Else

'check for 20 minutes before first event
    If DateDiff("s", 0, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value) <= timebeforeevent * 60 Then
   
         If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
            ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
            eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
         End If
    End If

End If

If triggerQuickPickListReload(Target.Worksheet.Index) Then
triggerQuickPickListReload(Target.Worksheet.Index) = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -3.1
triggerFirstMarketSelect(Target.Worksheet.Index) = True
Else
If triggerFirstMarketSelect(Target.Worksheet.Index) Then
triggerFirstMarketSelect(Target.Worksheet.Index) = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -5
End If
End If



Application.EnableEvents = True
End If
End Sub


[mak]

I am still at the office, I will test the last code at the evening & will let you know

[osknows]

Ok have tested this at home now and a slight amendment

This in a MODULE

Code: Select all

Option Explicit
'set to number of worksheets in workbook
Public triggerQuickPickListReload(1 To 10)  As Boolean
Public triggerFirstMarketSelect(1 To 10) As Boolean


Private Sub Workbook_Open()
Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"
End Sub


Public Sub loadQuickPickList()
Dim count_array As Integer

For count_array = 1 To UBound(triggerQuickPickListReload)
triggerQuickPickListReload(count_array) = True
Next

Application.OnTime TimeValue("05:00:00"), "loadQuickPickList"

End Sub

and this in as many SHEETS as you want to link to BA

Code: Select all

Option Explicit


Public lastrace As String
Public eventtriggertimer As Date
Dim ws As Worksheet
Const triggerduration As Integer = 20 'trigger every 20 minutes
Const timebeforeevent As Integer = 20 'monitor event only 20 minutes before start


Private Sub Worksheet_Change(ByVal Target As Range)


Application.EnableEvents = False

'reset timer on event change
If lastrace <> ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value Then
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
        lastrace = ThisWorkbook.Sheets(Target.Worksheet.Name).Range("A1").Value
End If

'check if time is in play & negative
If InStr(1, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value, "-", vbTextCompare) = 1 Then

     If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
        ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
        eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
     End If

Else

'check for 20 minutes before first event
    If DateDiff("s", 0, ThisWorkbook.Sheets(Target.Worksheet.Name).Range("D2").Value) <= timebeforeevent * 60 Then
   
         If DateDiff("s", CDate(eventtriggertimer), CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)) >= triggerduration * 60 Then
            ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -1
            eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
         End If
         
     Else
     
     eventtriggertimer = CDate(ThisWorkbook.Sheets(Target.Worksheet.Name).Range("B2").Value)
         
    End If

End If

If triggerQuickPickListReload(Target.Worksheet.Index) Then
triggerQuickPickListReload(Target.Worksheet.Index) = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -3.1
triggerFirstMarketSelect(Target.Worksheet.Index) = True
Else
If triggerFirstMarketSelect(Target.Worksheet.Index) Then
triggerFirstMarketSelect(Target.Worksheet.Index) = False
ThisWorkbook.Sheets(Target.Worksheet.Name).Range("Q2").Value = -5
End If
End If


Application.EnableEvents = True

End Sub


Ensure arrays in the in the MODULE (1 TO X) is above the count of worksheets in the workbook . Current default is (1 TO 10)

[mak]

hi
just place the last module but don't seem to work.It doesn't move to then next market at all.I link it to a greyhound market and named the first worksheet 1.

[osknows]

Try this link http://www.mediafire.com/?zu2uqgqf4qe

It has 3 worksheets set up and this works fine for me.

Note I've changed the trigger duration to 1 minute for testing and this seems to work fine?

Const triggerduration As Integer = 1 'trigger every 20 minutes
Const timebeforeevent As Integer = 20 'monitor event only 20 minutes

[mak]

Yes, Os it is working.
Thank you very much