Hi, the macro below builds number and then checks the next set it
builds against all the other sets it has built to see if there is a
match of
more than 4 numbers.
I expected it to be fast, it is, at the beginning... but slows down
dramatically the more it has to check... is so big a slow to be
expected?
or is there a tweak I have not done... cheers

ste

Full code

Sub chechformatches()

Dim A, B, C, D, E, F
Dim mycounter As Long
Dim hitcounter As Long
Dim allcounter As Long
Dim allscen As Long

Application.ScreenUpdating = False

hitcounter = 0

'Just clears the sheet ready for generation
Dim startcell, endcell, Rng As Range
Set startcell = Sheets("Max Lines").Range("A3")
Set endcell = Sheets("Max Lines").Range("G" & Rows.count).End
(xlUp).Offset(1, 0)
Set Rng = Range(startcell, endcell)
Rng.ClearContents
Rng.Interior.ColorIndex = xlNone
Sheets("Max Lines").Range("AB4:AB403").ClearContents


For A = 1 To 25
For B = A + 1 To 26
For C = B + 1 To 27
For D = C + 1 To 28
For E = D + 1 To 29
For F = E + 1 To 30

'+++++++++++++++++++++++++++++++++++++++++++++++++ +++++++++++++++++++++
++++++++++++++++++++++
'Check the generated line for a match of 4 or more from the previously
generated lines
Dim twoballarrArray(999999, 7) As Variant
Dim myintRow
Dim myintColumn
Dim AllMatches, myLastRow, myxlrow, myk, thematches As Long
Dim IfAthere, IfBthere, IfCthere, IfDthere, IfEthere, IfFthere As
Integer

myxlrow = 1

myLastRow = Sheets("Max Lines").Cells(myxlrow, 1).End(xlDown).Row
'Bottom of the table to check against

For myintColumn = 2 To 7 'The amount of columns wide
For myintRow = 2 To myLastRow 'The amount of Rows to go down

twoballarrArray(myintRow, myintColumn) = Sheets("Max Lines").Cells
(myintRow, myintColumn) ' The array to check, columns and rows

Next
Next

For myxlrow = 1 To myLastRow 'From the first row to the last row with
data in it

For myk = 2 To 7 'Check the columns

Select Case twoballarrArray(myxlrow, myk)
Case A: IfAthere = 1
Case B: IfBthere = 1
Case C: IfCthere = 1
Case D: IfDthere = 1
Case E: IfEthere = 1
Case F: IfFthere = 1
End Select

Next

AllMatches = IfAthere + IfBthere + IfCthere + IfDthere + IfEthere +
IfFthere 'The total of all the matches

IfAthere = 0
IfBthere = 0
IfCthere = 0
IfDthere = 0 ' Set the matches back to zero
IfEthere = 0
IfFthere = 0

If AllMatches 4 Then
thematches = 1
End If

Next
If thematches = 0 Then

'This writes all the data to the sheet much faster using the
array (the resize just expands the range to write in)
Dim z
z = Array(allscen, A, B, C, D, E, F)
Sheets("Max Lines").Range("A" & Rows.count).End(xlUp).Offset(1,
0).Resize(, 7) = z

hitcounter = hitcounter + 1

End If

AllMatches = 0
thematches = 0

mycounter = mycounter + 1

Application.StatusBar = "Checking Line" & " " & Format(A, "#00") & "
" & Format(B, "#00") & " " & Format(C, "#00") & " " & Format(D,
"#00") & " " & Format(E, "#00") & " " & Format(F, "#00") & " " & _
"Completed = " & Format(mycounter, "#00000000") & " " & "Found
Singular Repeat = " & Format(hitcounter, "#000")

Next F
Next E
Next D
Next C
Next B
Next A

Application.StatusBar = False

End Sub