find 6 matching numbers out of 20 vba good for kenoPrev TopicNext Topic

• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 9, 2017, 12:28 pm

  ▲▼

  sheet one should look like this format

  1	6	10	17	19	20	25	28	34	35	36	39	42	49	51	54	62	63	69	71	73
  2	1	5	10	11	12	13	20	23	25	27	29	40	42	44	47	63	65	66	75	80
  3	3	9	14	16	17	18	20	24	38	40	42	47	49	50	51	54	62	72	74	75
  4	7	11	12	15	21	22	31	33	40	42	43	45	48	51	52	56	57	68	70	80
  5	3	4	9	10	17	19	25	26	31	33	40	42	45	51	52	54	57	61	74	76
  6	4	7	9	17	18	21	26	30	46	52	53	56	65	68	69	70	73	74	76	80
  7	3	23	24	25	27	28	30	36	38	42	44	45	47	51	54	59	62	68	74	76
  8	8	12	15	18	20	21	23	30	38	39	42	47	50	52	57	60	75	76	78	80
  9	1	2	5	6	16	18	20	23	26	27	37	38	46	53	58	59	63	67	79	80
  10	8	20	21	23	29	31	35	36	38	40	47	49	51	54	56	62	66	67	72	80
  11	8	20	21	23	29	31	35	36	38	40	47	49	51	54	56	62	66	67	72	80
  12	8	20	21	23	29	31	35	36	38	40	47	49	51	54	56	62	66	67	72	80

   

  the vba code 

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

  Sub Combi6Max()
  Dim a%, b%, c%, d%, e%, f%, m%, n&, i&, dc As Object, k, T()
  Set dc = CreateObject("Scripting.Dictionary")
  
  With ActiveSheet
  n = .Cells(.Rows.Count, 1).End(xlUp).Row
  For i = 1 To n
  For a = 2 To 16
  For b = a + 1 To 17
  For c = b + 1 To 18
  For d = c + 1 To 19
  For e = d + 1 To 20
  For f = e + 1 To 21
  k = .Cells(i, a) & "|" & .Cells(i, b) & "|" & .Cells(i, c) & "|" _
  & .Cells(i, d) & "|" & .Cells(i, e) & "|" & .Cells(i, f)
  If dc.exists(k) Then
  m = CInt(dc(k)) + 1: dc(k) = m
  Else
  dc(k) = 1
  End If
  Next f
  Next e
  Next d
  Next c
  Next b
  Next a
  Next i
  End With
  
  For i = 2 To n - 1
  For Each k In dc.keys
  If CInt(dc(k)) < i Then dc.Remove (k)
  Next k
  If dc.Count < 1000 Then Exit For
  Next i
  
  ReDim T(dc.Count, 6): n = 0
  For Each k In dc.keys
  n = n + 1
  T(n, 6) = CInt(dc(k))
  For i = 0 To 5
  T(n, i) = Split(k, "|")(i)
  Next i
  Next k
  dc.RemoveAll
  T(0, 0) = "matching": T(0, 6) = "how many"
  
  Application.ScreenUpdating = False
  With Worksheets.Add(after:=Worksheets(ActiveSheet.Name))
  With .Range("A1").Resize(n + 1, 7)
  .Value = T
  .Columns("A:F").ColumnWidth = 5
  .Columns("G").ColumnWidth = 10
  .HorizontalAlignment = xlCenter
  With .Borders
  .LineStyle = xlContinuous
  .Weight = xlThin
  End With
  .Range("A1:F1").Merge
  End With
  With .Range("A2").Resize(n, 7)
  .Sort key1:=.Cells(1, 4), order1:=xlAscending, key2:=.Cells(1, 5), order2:=xlAscending, _
  key3:=.Cells(1, 6), order3:=xlAscending, Header:=xlNo
  .Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, _
  key3:=.Cells(1, 3), order3:=xlAscending, Header:=xlNo
  .Sort key1:=.Cells(1, 7), order1:=xlDescending, Header:=xlNo
  End With
  End With
  End Sub

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

  the end result   on sheet2 will look like this 

   

  matching						how many
  8	20	21	23	38	47	4
  8	20	21	23	38	80	4
  8	20	21	23	47	80	4
  8	20	21	38	47	80	4
  8	20	23	38	47	80	4
  8	21	23	38	47	80	4
  20	21	23	38	47	80	4
  20	23	29	40	47	66	4
  20	23	29	40	47	80	4
  20	23	29	40	66	80	4
  20	23	29	47	66	80	4
  20	23	40	47	66	80	4
  20	29	40	47	66	80	4
  20	35	36	49	51	54	4
  20	35	36	49	51	62	4
  20	35	36	49	54	62	4
  20	35	36	51	54	62	4
  20	35	49	51	54	62	4
  20	36	49	51	54	62	4
  20	38	40	47	49	51	4
  20	38	40	47	49	54	4
  20	38	40	47	49	62	4
  20	38	40	47	49	72	4
  20	38	40	47	51	54	4
  20	38	40	47	51	62	4
  20	38	40	47	51	72	4
  20	38	40	47	54	62	4
  20	38	40	47	54	72	4
  20	38	40	47	62	72	4
  20	38	40	49	51	54	4
  20	38	40	49	51	62	4
  20	38	40	49	51	72	4
  20	38	40	49	54	62	4
  20	38	40	49	54	72	4
  20	38	40	49	62	72	4
  20	38	40	51	54	62	4
  20	38	40	51	54	72	4
  20	38	40	51	62	72	4
  20	38	40	54	62	72	4
  20	38	47	49	51	54	4
  20	38	47	49	51	62	4
  20	38	47	49	51	72	4
  20	38	47	49	54	62	4
  20	38	47	49	54	72	4
  20	38	47	49	62	72	4
  20	38	47	51	54	62	4
  20	38	47	51	54	72	4
  20	38	47	51	62	72	4
  20	38	47	54	62	72	4
  20	38	49	51	54	62	4
  20	38	49	51	54	72	4
  20	38	49	51	62	72	4
  20	38	49	54	62	72	4
  20	38	51	54	62	72	4
  20	40	47	49	51	54	4
  20	40	47	49	51	62	4
  20	40	47	49	51	72	4
  20	40	47	49	54	62	4
  20	40	47	49	54	72	4
  20	40	47	49	62	72	4
  20	40	47	51	54	62	4
  20	40	47	51	54	72	4
  20	40	47	51	62	72	4
  20	40	47	54	62	72	4
  20	40	49	51	54	62	4
  20	40	49	51	54	72	4
  20	40	49	51	62	72	4
  20	40	49	54	62	72	4
  20	40	51	54	62	72	4
  20	47	49	51	54	62	4
  20	47	49	51	54	72	4
  20	47	49	51	62	72	4
  20	47	49	54	62	72	4
  20	47	51	54	62	72	4
  20	49	51	54	62	72	4
  21	31	40	51	56	80	4
  23	29	40	47	66	80	4
  23	36	38	47	51	54	4
  23	36	38	47	51	62	4
  23	36	38	47	54	62	4
  23	36	38	51	54	62	4
  23	36	47	51	54	62	4
  23	38	47	51	54	62	4
  35	36	49	51	54	62	4
  36	38	47	51	54	62	4
  38	40	47	49	51	54	4
  38	40	47	49	51	62	4
  38	40	47	49	51	72	4
  38	40	47	49	54	62	4
  38	40	47	49	54	72	4
  38	40	47	49	62	72	4
  38	40	47	51	54	62	4
  38	40	47	51	54	72	4
  38	40	47	51	62	72	4
  38	40	47	54	62	72	4
  38	40	49	51	54	62	4
  38	40	49	51	54	72	4
  38	40	49	51	62	72	4
  38	40	49	54	62	72	4
  38	40	51	54	62	72	4
  38	47	49	51	54	62	4
  38	47	49	51	54	72	4
  38	47	49	51	62	72	4
  38	47	49	54	62	72	4
  38	47	51	54	62	72	4
  38	49	51	54	62	72	4
  40	47	49	51	54	62	4
  40	47	49	51	54	72	4
  40	47	49	51	62	72	4
  40	47	49	54	62	72	4
  40	47	51	54	62	72	4
  40	49	51	54	62	72	4
  47	49	51	54	62	72	4
• DownandDirty

  

  Long Island, NY
  United States
  Member #57,410
  January 3, 2008
  446 Posts
  Offline
  Oct 9, 2017, 10:38 pm

  ▲▼

  I play Keno and wish I could understand what it is you are outlining here.

  Let me start with a few stupid questions.

   

  What is a VBA Code?

  What is on Sheet 1 and 2?

  You say 6 Matching numbers out of 20..but I dont see one column or row with 20 numbers.?

  I must be stupid..really...
• winsumloosesum

  

  Philadelpia/Pennsylvania
  United States
  Member #2,218
  September 1, 2003
  6,802 Posts
  Offline
  Oct 10, 2017, 7:09 am

  ▲▼

  Keno Excel file:

  https://1drv.ms/u/s!AifgvyqwTTMrh1rDAlvEQqxLgrFX

  What is a VBA Code?  Visual Basic for Applications.  Programming language used for Microsoft Excel, Word, etc.

  What is on Sheet 1 and 2? Sheet 1 contains a listing of 12 drawings.  Each drawing has 20 sets for each drawing.

  You say 6 Matching numbers out of 20..but I dont see one column or row with 20 numbers.?

  VBA code creates a list of 6 keno numbers from the draw history and how many times a six number list appears in the draw history.

  The download link zip file contains the Excel file using Timmsy's example.

   

  
• CARBOB

  

  COLUMBUS,GA.
  United States
  Member #4,924
  June 3, 2004
  6,719 Posts
  Offline
  Oct 10, 2017, 9:32 am

  ▲▼

  Steve,

  How much work would it be to create an Ga keno db for one years draw?
• winsumloosesum

  

  Philadelpia/Pennsylvania
  United States
  Member #2,218
  September 1, 2003
  6,802 Posts
  Offline
  Oct 10, 2017, 3:15 pm

  ▲▼
  In response to CARBOB

  Quote: Originally posted by CARBOB on Oct 10, 2017

  Steve,

  How much work would it be to create an Ga keno db for one years draw?

  Bob,

  Just substitute the GA Keno draws from last 365 draws.  Number the draws 1 through 365 in cell column A then copy and paste your 365 past draws starting in cell B1 then click the toolbar.  365 draws may take some time to calculate depending on the speed of your computer.

  I would be interested to know how long 365 past draws takes.
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 10, 2017, 3:52 pm

  ▲▼

  For one year  will take a very long time unless you have a super computer.
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 10, 2017, 4:00 pm

  ▲▼

  I also have code for 5 macthing numbers as well if anyone wants ?
• winsumloosesum

  

  Philadelpia/Pennsylvania
  United States
  Member #2,218
  September 1, 2003
  6,802 Posts
  Offline
  Oct 10, 2017, 9:26 pm

  ▲▼
  In response to timmsy

  Quote: Originally posted by timmsy on Oct 10, 2017

  I also have code for 5 macthing numbers as well if anyone wants ?

  Please share when you have time.

  Thanks
• kreative1

  

  NE PA
  United States
  Member #127,832
  May 10, 2012
  1,392 Posts
  Offline
  Oct 10, 2017, 9:48 pm

  ▲▼
  In response to DownandDirty

  Quote: Originally posted by DownandDirty on Oct 9, 2017

  I play Keno and wish I could understand what it is you are outlining here.

  Let me start with a few stupid questions.

   

  What is a VBA Code?

  What is on Sheet 1 and 2?

  You say 6 Matching numbers out of 20..but I dont see one column or row with 20 numbers.?

  I must be stupid..really...

  You aren't stupid  Sometimes when people post something, they think because they know what it means so should we lol and then you have someone like winsum and others who take the time to explain it to us 

  Eve front pairs due for str8
         
  doubles overdue
  575,755
• CARBOB

  

  COLUMBUS,GA.
  United States
  Member #4,924
  June 3, 2004
  6,719 Posts
  Offline
  Oct 11, 2017, 6:21 am

  ▲▼
  In response to winsumloosesum

  Quote: Originally posted by winsumloosesum on Oct 10, 2017

  Bob,

  Just substitute the GA Keno draws from last 365 draws.  Number the draws 1 through 365 in cell column A then copy and paste your 365 past draws starting in cell B1 then click the toolbar.  365 draws may take some time to calculate depending on the speed of your computer.

  I would be interested to know how long 365 past draws takes.

  Thanks Steve. Changed my mind, Georgia's history is in a dumb format.
• dr san

  

  bgonçalves
  Brasil
  Member #92,560
  June 9, 2010
  3,779 Posts
  Offline
  Oct 11, 2017, 7:44 am

  ▲▼

  My keno is 100/20
  You draw 20 numbers in 100 (00 to 99)
    Please!
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 12, 2017, 10:23 pm

  ▲▼

  Ok almost done with this new vba  .. the new vba will find 10 matching numbers out of 20 numbers.
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 13, 2017, 6:14 am

  ▲▼

  Post a reply to  find  5 matching numbers out of 20 vba good for keno

   

  Sub CombiMax5()
  On Error Resume Next
  Dim a%, b%, c%, d%, e%, m%, n&, i&, dc As Object, k, T()
  Set dc = CreateObject("Scripting.Dictionary")
  
  With ActiveSheet
  n = .Cells(.Rows.Count, 1).End(xlUp).Row
  For i = 1 To n
  For a = 2 To 17
  For b = a + 1 To 18
  For c = b + 1 To 19
  For d = c + 1 To 20
  For e = d + 1 To 21
  k = .Cells(i, a) & "|" & .Cells(i, b) & "|" & .Cells(i, c) & "|" _
  & .Cells(i, d) & "|" & .Cells(i, e)
  If dc.exists(k) Then
  m = CInt(dc(k)) + 1: dc(k) = m
  Else
  dc(k) = 1
  End If
  Next e
  Next d
  Next c
  Next b
  Next a
  Next i
  End With
  
  For i = 2 To n - 1
  For Each k In dc.keys
  If CInt(dc(k)) < i Then dc.Remove (k)
  Next k
  If dc.Count < 1000 Then Exit For
  Next i
  
  ReDim T(dc.Count, 5): n = 0
  For Each k In dc.keys
  n = n + 1
  T(n, 5) = CInt(dc(k))
  For i = 0 To 4
  T(n, i) = Split(k, "|")(i)
  Next i
  Next k
  dc.RemoveAll
  T(0, 0) = "combinations of 5": T(0, 5) = "Hits"
  'Affectation et mise en forme, tri
  Application.ScreenUpdating = False
  With Worksheets.Add(after:=Worksheets(ActiveSheet.Name))
  With .Range("A1").Resize(n + 1, 6)
  .Value = T
  .Columns("A:E").ColumnWidth = 5
  .Columns("F").ColumnWidth = 10
  .HorizontalAlignment = xlCenter
  With .Borders
  .LineStyle = xlContinuous
  .Weight = xlThin
  End With
  .Range("A1:E1").Merge
  End With
  With .Range("A2").Resize(n, 6)
  .Sort key1:=.Cells(1, 3), order1:=xlAscending, key2:=.Cells(1, 4), order2:=xlAscending, _
  key3:=.Cells(1, 5), order3:=xlAscending, Header:=xlNo
  .Sort key1:=.Cells(1, 6), order1:=xlDescending, key2:=.Cells(1, 1), order2:=xlAscending, _
  key3:=.Cells(1, 2), order3:=xlAscending, Header:=xlNo
  End With
  End With
  End Sub
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 13, 2017, 6:14 am

  ▲▼

  Post a reply to  find 10  matching numbers out of 20 vba good for keno

   

  Sub combo10()
  On Error Resume Next
  Dim a%, b%, c%, d%, e%, f%, g%, h%, i%, j%, m%, n&, p&, dc As Object, r, T()
  Set dc = CreateObject("Scripting.Dictionary")
  'Collection combinations
  With ActiveSheet
  n = .Cells(.Rows.Count, 1).End(xlUp).Row
  For p = 1 To n
  For a = 2 To 12
  For b = a + 1 To 13
  For c = b + 1 To 14
  For d = c + 1 To 15
  For e = d + 1 To 16
  For f = e + 1 To 17
  For g = f + 1 To 18
  For h = g + 1 To 19
  For i = h + 1 To 20
  For j = i + 1 To 21

  r = .Cells(p, a) & "|" & .Cells(p, b) & "|" & .Cells(p, c) & "|" _
  & .Cells(p, d) & "|" & .Cells(p, e) & "|" & .Cells(p, f) & "|" & .Cells(p, g) & "|" & .Cells(p, h) & "|" & .Cells(p, i) & "|" & .Cells(p, j)
  If dc.exists(r) Then
  m = CInt(dc(r)) + 1: dc(r) = m
  Else
  dc(r) = 1
  End If
  Next j
  Next i
  Next h
  Next g
  Next f
  Next e
  Next d
  Next c
  Next b
  Next a
  Next p
  End With
  '
  For p = 2 To n - 1
  For Each r In dc.keys
  If CInt(dc(r)) < p Then dc.Remove (r)
  Next r
  If dc.Count < 1000 Then Exit For
  
  Next p
  
  'Array
  ReDim T(dc.Count, 10): n = 0
  For Each r In dc.keys
  n = n + 1
  T(n, 10) = CInt(dc(r))
  For p = 0 To 9
  T(n, p) = Split(r, "|")(p)
  Next p
  Next r
  dc.RemoveAll
  T(0, 0) = "combinations of 10": T(0, 10) = "Hits"
  'Assignment and formatting, sorting
  Application.ScreenUpdating = False
  With Worksheets.Add(after:=Worksheets(ActiveSheet.Name))
  With .Range("A1").Resize(n + 1, 11)
  .Value = T
  .Columns("A:j").ColumnWidth = 5
  .Columns("k").ColumnWidth = 10
  .HorizontalAlignment = xlCenter
  With .Borders
  .LineStyle = xlContinuous
  .Weight = xlThin
  End With
  .Range("A1:j1").Merge
  End With
  With .Range("A2").Resize(n, 11)

  .Sort key1:=.Cells(1, 8), order1:=xlAscending, key2:=.Cells(1, 9), order2:=xlAscending, _
  key3:=.Cells(1, 10), order3:=xlAscending, Header:=xlNo

  .Sort key1:=.Cells(1, 1), order1:=xlAscending, key2:=.Cells(1, 2), order2:=xlAscending, _
  key3:=.Cells(1, 3), order3:=xlAscending, Header:=xlNo

  .Sort key1:=.Cells(1, 7), order1:=xlDescending, Header:=xlNo
  .Sort key1:=.Cells(1, 8), order1:=xlDescending, Header:=xlNo
  .Sort key1:=.Cells(1, 9), order1:=xlDescending, Header:=xlNo
  .Sort key1:=.Cells(1, 10), order1:=xlDescending, Header:=xlNo
  .Sort key1:=.Cells(1, 11), order1:=xlDescending, Header:=xlNo
  End With
  End With
  End Sub
• timmsy

  

  Australia
  Member #154,621
  April 23, 2014
  228 Posts
  Offline
  Oct 13, 2017, 6:20 am

  ▲▼

  Post a reply to    find  5 matching numbers out of 20 vba good for keno

  note if you need to find  5 matching numbers out of 10 numbers using the 5 matching vba  the code should look like this 

   

  With ActiveSheet
  n = .Cells(.Rows.Count, 1).End(xlUp).Row
  For i = 1 To n
  For a = 2 To 7
  For b = a + 1 To 8
  For c = b + 1 To 9
  For d = c + 1 To 10
  For e = d + 1 To 11

   

  also note your data sheet should have all the lotto numbers in order and  not mixed , otherwise the vba will not work very well 

  good luck