Hi, I need some help with a vba code.
I like to add the "Reload quick pick list at midnight" code into the code in this thread. I tried it with copy and paste but got an error (of course
).
Could someone add
http://www.gruss-software.co.uk/Excel/AutoReloadQuickpickList.xls this?
-> i like to reload the qpl (all ip football correct score (!) - its also done by the preference option) at midnight and select the frist market within the qpl.
....::: Sheet 1 :::....
Option Explicit
Dim dtStart As Long
Dim dtEnd As Long
Dim refreshTimes As Collection
Dim elapsedTime As Long
Dim totRefresh As Long
Dim refreshed As Boolean
Dim refreshCount As Long
Const avgCount As Long = 10
Dim currentMarket As String
Dim resetTriggeronLastMarket As Long
Dim nextracetrigger As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngArray() As Variant
Dim TimerArray(1 To 2, 1 To 1) As Long
If Target.Columns.Count = 16 Then
Application.EnableEvents = False
With Target.Parent
'**Timer to measure time in ticks/ms of previous refresh and average of last 10
If Not refreshed Then
refreshed = True
dtStart = GetTickCount
Set refreshTimes = New Collection
refreshCount = 0
Else
dtEnd = GetTickCount
refreshCount = refreshCount + 1
elapsedTime = dtEnd - dtStart
refreshTimes.Add Str(elapsedTime), Str(refreshCount)
totRefresh = totRefresh + elapsedTime
If refreshCount > avgCount Then
totRefresh = totRefresh - Val(refreshTimes(Str(refreshCount - avgCount)))
refreshTimes.Remove (Str(refreshCount - avgCount))
TimerArray(1, 1) = totRefresh / avgCount
End If
TimerArray(2, 1) = elapsedTime
.Range("W2:W3").Value = TimerArray
dtStart = dtEnd
End If
rngArray = .Range("A1:BZ61").Value2
'Count refreshes of next nextracetrigger. Rester after 5 refreshes
If nextracetrigger = 1 Then resetTriggeronLastMarket = resetTriggeronLastMarket + 1
If rngArray(1, 1) <> currentMarket Or resetTriggeronLastMarket >= 5 Then
'New Market Selected
currentMarket = rngArray(1, 1)
.Range("V1").Value = rngArray(2, 3)
nextracetrigger = 0
resetTriggeronLastMarket = 0
Application.EnableEvents = True
Exit Sub
End If
If triggerQuickPickListReload Then
triggerQuickPickListReload = False
Range("Q2").Value = -3
triggerFirstMarketSelect = True
Else
If triggerFirstMarketSelect Then
triggerFirstMarketSelect = False
Range("Q2").Value = -5
End If
End If
'Delete Closed or Inplay Markets
'**If setting is ON then -8 trigger in cell [Q2] will delete the current market
'**from the quickpicklist. Will only delete In Play and Closed markets
If Settings.Range("B4").Value = "ON" And nextracetrigger = 0 And _
(rngArray(2, 6) = "Closed" Or rngArray(2, 5) = "In Play") Then
nextracetrigger = 1
.Range("Q2").Value = -8
End If
'Cycle Markets
If Settings.Range("B3").Value = "ON" And nextracetrigger = 0 And Target.Rows.Count >= 5 Then
If rngArray(2, 22) >= Settings.Range("B2").Value Then
If rngArray(3, 10) = "L" Then
.Range("Q2") = -5
Else
.Range("Q2") = -1
End If
nextracetrigger = 1
End If
End If
End With
Application.EnableEvents = True
End If
End Sub
.....:::: ThisWorkbook ::::....
Option Explicit
Private Sub Workbook_Open()
Application.OnTime TimeValue("00:00:00"), "loadQuickPickList"
End Sub
Thank you!!