Good work there but I personally dont do or believe in random number generators its a waste of your money you can just aswell get a quick pick and throw your money at it and hope and pray
Here is also one on the powerball but its draws a frequency of the top hitters after the scraping
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