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

when you use arrays it will but the arrays in memory and depending on
the available memory on your computer will determine the speed. The PC
swaps unused data in memory to the hard drive which is a slow process.

The VBA routines on the worksheet are optimize for speed. Sometimes
code will run faster if you use arrays and sometimes it won't. Usually
samll amounts of data the you will access often in a macro are ideal to
put into memory. Large amounts of data it is better to keep the data on
the worksheet and not to use arrays.


--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=145585

Thank Joel,

So there is no obvious alteration I can make to increase the speed as
it is?

I just thought it would be quicker!

I thought with the table being in memory it would be ok... hmmmm...

Ste

There is a very large overhead time whenever VBA reads from a worksheet or
writes to a worksheet.
(see Variant Benchmark http://www.decisionmodels.com/downloads.htm )

So its nearly always better to start the routine by reading all the data
from the worksheet straight into a variant, then do the loops just on
arrays, then when the loops are finished write back to the worksheet.

The reason your VBA is slow is because you are reading a cell and writing a
small array to cells on each iteration of your inmost loop, so the routine
incurs the large overhead on every single iteration of the loops.

regards
Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com


"Ste Mac" wrote in message
...
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

Hi Charles, wow, this is interesting can you give me an example
please...

So, you are saying do not write anything to the sheet until the end?

Ste

Yes, keep all the intermediate stuff in arrays then write to the sheet at
the end.

here is a simple example reading and writing about 260000 cells

option base 1
option explicit
sub SteCheck()
dim vArr as variant
dim j as long
dim k as long

'read from a sheet into a variant
vArr=Worksheets("MySheet").Range("A3:Z10000")
' varr now contains a 2-dimensional array of worksheet data

for j=lbound(varr,1) to ubound(varr,1)
' loop on rows
for k=lbound(varr,2) to Ubound(varr,2)
' loop on cols
varr(j,k)=varr(j,k)+j*k
next k
next j

' write result back
Worksheets("MySheet").Range("A3:Z10000")=varr

end sub

Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com

"Ste Mac" wrote in message
...
Hi Charles, wow, this is interesting can you give me an example
please...

So, you are saying do not write anything to the sheet until the end?

Ste

Charles, I have just run your example and my word its fast, I would
NEVER have looked in this direction.

The macro I have was put together from people such as yourself in this
ng.

Charles, will show me how you would insert your code into mine please.

This is most interesting.

Thankyou very much

Ste

Just out of curiosity, exactly what is your code accomplishing (that is,
what is the start condition and what end condition are you looking to
achieve)... I just have this "feeling" there may be a different, more
efficient approach available, but I am not totally sure what your code is
attempting to do.

--
Rick (MVP - Excel)


"Ste Mac" wrote in message
...
Charles, I have just run your example and my word its fast, I would
NEVER have looked in this direction.

The macro I have was put together from people such as yourself in this
ng.

Charles, will show me how you would insert your code into mine please.

This is most interesting.

Thankyou very much

Ste