PAB
04-07-2017, 05:32 AM
Good afternoon,
I have lotto dates starting in range D8 and continuing downwards.
I have lotto balls drawn starting in range E8:J and continuing downwards.
The code below cycles down the range E8:J as long as there is a lotto date in column D.
The code produces ALL the triples that have NOT been drawn in any of the draws.
This code works fine but takes a while to run.
My question is please, is there anyway that this code can be optimized with regard to the nx3 part?
Option Explicit
Option Base 1
Const nMax As Integer = 59
Const Criteria As Integer = 0
Const SepChar As String = " "
Dim i As Integer, j As Integer, k As Integer
Dim nx3() As Integer
Dim nNum(6) As Integer
Dim Cel As Range
Sub Triples_VBA_Express()
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
ReDim nx3(nMax, nMax, nMax)
Set Cel = Range("D8")
Do While Cel.Value <> ""
For j = 1 To 6
nNum(j) = Cel.Offset(0, j).Value
Next j
nx3(nNum(1), nNum(2), nNum(3)) = nx3(nNum(1), nNum(2), nNum(3)) + 1
nx3(nNum(1), nNum(2), nNum(4)) = nx3(nNum(1), nNum(2), nNum(4)) + 1
nx3(nNum(1), nNum(2), nNum(5)) = nx3(nNum(1), nNum(2), nNum(5)) + 1
nx3(nNum(1), nNum(2), nNum(6)) = nx3(nNum(1), nNum(2), nNum(6)) + 1
nx3(nNum(1), nNum(3), nNum(4)) = nx3(nNum(1), nNum(3), nNum(4)) + 1
nx3(nNum(1), nNum(3), nNum(5)) = nx3(nNum(1), nNum(3), nNum(5)) + 1
nx3(nNum(1), nNum(3), nNum(6)) = nx3(nNum(1), nNum(3), nNum(6)) + 1
nx3(nNum(1), nNum(4), nNum(5)) = nx3(nNum(1), nNum(4), nNum(5)) + 1
nx3(nNum(1), nNum(4), nNum(6)) = nx3(nNum(1), nNum(4), nNum(6)) + 1
nx3(nNum(1), nNum(5), nNum(6)) = nx3(nNum(1), nNum(5), nNum(6)) + 1
nx3(nNum(2), nNum(3), nNum(4)) = nx3(nNum(2), nNum(3), nNum(4)) + 1
nx3(nNum(2), nNum(3), nNum(5)) = nx3(nNum(2), nNum(3), nNum(5)) + 1
nx3(nNum(2), nNum(3), nNum(6)) = nx3(nNum(2), nNum(3), nNum(6)) + 1
nx3(nNum(2), nNum(4), nNum(5)) = nx3(nNum(2), nNum(4), nNum(5)) + 1
nx3(nNum(2), nNum(4), nNum(6)) = nx3(nNum(2), nNum(4), nNum(6)) + 1
nx3(nNum(2), nNum(5), nNum(6)) = nx3(nNum(2), nNum(5), nNum(6)) + 1
nx3(nNum(3), nNum(4), nNum(5)) = nx3(nNum(3), nNum(4), nNum(5)) + 1
nx3(nNum(3), nNum(4), nNum(6)) = nx3(nNum(3), nNum(4), nNum(6)) + 1
nx3(nNum(3), nNum(5), nNum(6)) = nx3(nNum(3), nNum(5), nNum(6)) + 1
nx3(nNum(4), nNum(5), nNum(6)) = nx3(nNum(4), nNum(5), nNum(6)) + 1
Set Cel = Cel.Offset(1, 0)
Loop
Set Cel = Range("P7")
For i = 1 To nMax - 2
For j = i + 1 To nMax - 1
For k = j + 1 To nMax
If nx3(i, j, k) = Criteria Then
Set Cel = Cel.Offset(1, 0)
Cel.Offset(0, 0) = _
Format(i, "00") & SepChar & _
Format(j, "00") & SepChar & _
Format(k, "00")
Cel.Offset(0, 1).Value = nx3(i, j, k)
End If
Next k
Next j
Next i
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Thanks in advance.
I have lotto dates starting in range D8 and continuing downwards.
I have lotto balls drawn starting in range E8:J and continuing downwards.
The code below cycles down the range E8:J as long as there is a lotto date in column D.
The code produces ALL the triples that have NOT been drawn in any of the draws.
This code works fine but takes a while to run.
My question is please, is there anyway that this code can be optimized with regard to the nx3 part?
Option Explicit
Option Base 1
Const nMax As Integer = 59
Const Criteria As Integer = 0
Const SepChar As String = " "
Dim i As Integer, j As Integer, k As Integer
Dim nx3() As Integer
Dim nNum(6) As Integer
Dim Cel As Range
Sub Triples_VBA_Express()
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
End With
ReDim nx3(nMax, nMax, nMax)
Set Cel = Range("D8")
Do While Cel.Value <> ""
For j = 1 To 6
nNum(j) = Cel.Offset(0, j).Value
Next j
nx3(nNum(1), nNum(2), nNum(3)) = nx3(nNum(1), nNum(2), nNum(3)) + 1
nx3(nNum(1), nNum(2), nNum(4)) = nx3(nNum(1), nNum(2), nNum(4)) + 1
nx3(nNum(1), nNum(2), nNum(5)) = nx3(nNum(1), nNum(2), nNum(5)) + 1
nx3(nNum(1), nNum(2), nNum(6)) = nx3(nNum(1), nNum(2), nNum(6)) + 1
nx3(nNum(1), nNum(3), nNum(4)) = nx3(nNum(1), nNum(3), nNum(4)) + 1
nx3(nNum(1), nNum(3), nNum(5)) = nx3(nNum(1), nNum(3), nNum(5)) + 1
nx3(nNum(1), nNum(3), nNum(6)) = nx3(nNum(1), nNum(3), nNum(6)) + 1
nx3(nNum(1), nNum(4), nNum(5)) = nx3(nNum(1), nNum(4), nNum(5)) + 1
nx3(nNum(1), nNum(4), nNum(6)) = nx3(nNum(1), nNum(4), nNum(6)) + 1
nx3(nNum(1), nNum(5), nNum(6)) = nx3(nNum(1), nNum(5), nNum(6)) + 1
nx3(nNum(2), nNum(3), nNum(4)) = nx3(nNum(2), nNum(3), nNum(4)) + 1
nx3(nNum(2), nNum(3), nNum(5)) = nx3(nNum(2), nNum(3), nNum(5)) + 1
nx3(nNum(2), nNum(3), nNum(6)) = nx3(nNum(2), nNum(3), nNum(6)) + 1
nx3(nNum(2), nNum(4), nNum(5)) = nx3(nNum(2), nNum(4), nNum(5)) + 1
nx3(nNum(2), nNum(4), nNum(6)) = nx3(nNum(2), nNum(4), nNum(6)) + 1
nx3(nNum(2), nNum(5), nNum(6)) = nx3(nNum(2), nNum(5), nNum(6)) + 1
nx3(nNum(3), nNum(4), nNum(5)) = nx3(nNum(3), nNum(4), nNum(5)) + 1
nx3(nNum(3), nNum(4), nNum(6)) = nx3(nNum(3), nNum(4), nNum(6)) + 1
nx3(nNum(3), nNum(5), nNum(6)) = nx3(nNum(3), nNum(5), nNum(6)) + 1
nx3(nNum(4), nNum(5), nNum(6)) = nx3(nNum(4), nNum(5), nNum(6)) + 1
Set Cel = Cel.Offset(1, 0)
Loop
Set Cel = Range("P7")
For i = 1 To nMax - 2
For j = i + 1 To nMax - 1
For k = j + 1 To nMax
If nx3(i, j, k) = Criteria Then
Set Cel = Cel.Offset(1, 0)
Cel.Offset(0, 0) = _
Format(i, "00") & SepChar & _
Format(j, "00") & SepChar & _
Format(k, "00")
Cel.Offset(0, 1).Value = nx3(i, j, k)
End If
Next k
Next j
Next i
With Application
.DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
End With
End Sub
Thanks in advance.