Frequency does not guarantee big wins but it can help to narrow down better hitters....Here is a vba code to work out the frequency of the top hitters with a scraper to download the powerball results 1-69/26
CODE
Option Explicit
Type typeRec
Bin As Integer
Freq As Integer
End Type
Sub Process()
Dim WsWeb As Worksheet
Dim WsData As Worksheet
Dim WsCalc As Worksheet
Dim qt As QueryTable
Dim WsWebRowNo As Long
Dim WsDataRowNo As Long
Dim Draw As String
Dim N As Variant
Dim I As Integer
Dim MaxDateData As Date
Set WsWeb = ThisWorkbook.Worksheets("WebScrape")
Set WsData = ThisWorkbook.Worksheets("Data")
Set WsCalc = ThisWorkbook.Worksheets("Calculations")
'Extract the informationn from the website
Call DeleteQT
WsWeb.Cells.Clear
Call DrawNumbers
Set qt = WsWeb.QueryTables(1)
WsDataRowNo = WsData.Cells(WsData.Rows.Count, "A").End(xlUp).Row + 1
MaxDateData = Application.WorksheetFunction.Max(WsData.Columns("B:B"))
For WsWebRowNo = 2 To WsWeb.Cells(WsWeb.Rows.Count, "A").End(xlUp).Row
If WsWeb.Cells(WsWebRowNo, "B") > MaxDateData Then
WsData.Cells(WsDataRowNo, "A") = WsWeb.Cells(WsWebRowNo, "A")
WsData.Cells(WsDataRowNo, "B") = WsWeb.Cells(WsWebRowNo, "B")
Draw = Replace(WsWeb.Cells(WsWebRowNo, "C"), " ", "-")
N = Split(Draw, "-")
For I = 0 To UBound(N)
WsData.Cells(WsDataRowNo, 3 + I) = N(I)
Next I
WsDataRowNo = WsDataRowNo + 1
End If
Next
WsDataRowNo = WsData.Cells(WsData.Rows.Count, "A").End(xlUp).Row
ThisWorkbook.Names.Add Name:="DrawRng", RefersToR1C1:="=Data!R2C3:R" & WsDataRowNo & "C7"
ThisWorkbook.Names.Add Name:="PbRng", RefersToR1C1:="=Data!R2C8:R" & WsDataRowNo & "C8"
Call UpdateCalcWS(WsCalc)
End Sub
Function UpdateCalcWS(WsCalc As Worksheet)
'Add Formula Arrays to Calculations WorkSheet
WsCalc.Range("C2:C69").FormulaArray = "=FREQUENCY(DrawRng,RC[-1]:R[69]C[-1])"
WsCalc.Range("D2:D27").FormulaArray = "=FREQUENCY(pbRng,RC[-2]:R[34]C[-2])"
'Copy the Draw Freqs to a new range
WsCalc.Range("E2:F69").Value = Range("B2:C69").Value
WsCalc.Range("G2:G27").Value = Range("B2:B27").Value
WsCalc.Range("H2:H27").Value = Range("D2:D27").Value
WsCalc.Range("E1:F69").Sort Key1:=WsCalc.Range("F1"), Order1:=xlDescending, _
Header:=xlYes, _
MatchCase:=False, _
Orientation:=xlTopToBottom
WsCalc.Range("G1:H26").Sort Key1:=WsCalc.Range("H1"), Order1:=xlDescending, _
Header:=xlYes, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End Function
Function SortIt(WsCalc As Worksheet, strRng As String, SortCol As String)
Application.CutCopyMode = False
WsCalc.Sort.SortFields.Clear
WsCalc.Sort.SortFields.Add Key:=WsCalc.Columns(SortCol), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With WsCalc.Sort
.SetRange Range(strRng)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Function
Function DrawNumbers()
Dim WS As Worksheet
Set WS = ThisWorkbook.Worksheets("WebScrape")
With WS.QueryTables.Add(Connection:= _
"URL;http://www.tnlottery.com/winningnumbers/default.aspx#pwrball", Destination:=WS.Range("$A$1"))
.Name = "pwrball"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "dgPowerBallWinners"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Function
Function DeleteQT()
Dim qt As QueryTable
For Each qt In ThisWorkbook.Worksheets("WebScrape").QueryTables
qt.Delete
Next
End Function