Search faster using array - But it slows down

[Ste Mac]

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

 

[Ste Mac]

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

 

[Charles Williams]

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]

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 Williams]

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]

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

 

[Rick Rothstein]

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.

 

[Ste Mac]

Hi Rick, the code builds a line of numbers (starting 1,2,3,4,5,6) and
so on... once a set of numbers
has been 'kept' I do not want another set of numbers that have 4 or
more of the numbers that have been
'kept' in them, hence the match bit.

Charles has shown me that the data, instead of being written to the
sheet on each 'kept' set of numbers,
it can be saved until the end and write the whole lot to the sheet at
once.

I do not know how to do this: ie save all the data until the end.

Charles wrote an example piece of code, I have had a play with it and
it is very very fast, and would like to
see it utilised in my macro...

Ste

 

[Rick Rothstein]

I'm sorry, but your have not added significantly to your previous
description of what you want your output to look like for me to understand
what you are attempting to do. Could you, perhaps, give a sample output
(Columns A to G) of a few lines of what you expect the code to produce and
and example or two of what you would consider as invalid output. Try and
remember you are describing some you are intimately familiar with to a bunch
of people who have no idea what you are trying to do... that means you
cannot take for granted any information in your description.

 

[Ste Mac]

Apologies Rick... l'll try again

The macro generates 6 numbers starting with 1-2-3-4-5-6 and then
1-2-3-4-5-7 and so on...

What l am trying to do is, if a set of numbers generated has 4 or more
numbers in a set
of six numbers that have already been generated then l do not want the
line...

An example:

1-2-3-4-5-6 has been generated by the macro (this line is kept)
1-2-3-4-5-7 is the next generated numbers: But it has 4 or more
numbers from the previously generated number - no good
1-2-3-4-5-8 is the next but still has 4 or more numbers from the 1st
generated numbers - no good
1-2-3-4-5-9 is the next but still has 4 or more numbers from the 1st
generated numbers - no good

and so on, until a set of generated numbers arrive that have 4 or less
numbers fron any of the previously kept lines

The next generated lin that has 4 or less numbers from the 'kept' sets
is:
1-2-3-4-7-8

So we have kept
1-2-3-4-5-6
1-2-3-4-7-8
1-2-3-4-9-10
1-2-3-4-11-12
Which all have 4 or less numbers from the generated sets of 6 numbers

The macro works fine, the problem arises when the 'kept' sets of
numbers start to mount up, it takes longer
and longer to check them and/or write them to the sheet....

I changed Charles's example to write out approx 500,000 numbers and it
only took about 3 seconds
but I have no idea how to implement his code... but it look like he
was dead right about writing the data
to the sheet...

But perhaps I am going about this the wrong way Rick... and there is a
different way of doing this quickly...

This is all very interesting and a big learning curve...

Thanks a lot

Ste

 

[Ste Mac]

Sorry for the late reply (had to go to work)

How would one store all the values in the array until the code has
run?

I can understand the concept, but this is beyond my programming skills

cheers

Ste

 

[Charles Williams]

Try this: still quite slow - runs in 2 min 45 secs on my system.
Not sure if the results are correct!

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

Option Explicit
Option Base 1
Sub chechformatches()

Dim A As Long
Dim B As Long
Dim C As Long
Dim D As Long
Dim E As Long
Dim F As Long
Dim Results(10000, 6) As Long
Dim nFound As Long
Dim j As Long
Dim k As Long
Dim L As Long
Dim blNew As Boolean
Dim jSet(6) As Long
Dim nSame As Long

Application.ScreenUpdating = False

Worksheets("Results").UsedRange.Clear


For A = 1 To 25
jSet(1) = A
For B = A + 1 To 26
jSet(2) = B
For C = B + 1 To 27
jSet(3) = C
For D = C + 1 To 28
jSet(4) = D
For E = D + 1 To 29
jSet(5) = E
blNew = True
For F = E + 1 To 30
If Not blNew Then Exit For
jSet(6) = F

If nFound > 0 Then

For j = nFound To 1 Step -1
nSame = 0
For k = 1 To 6
For L = 1 To 6
If jSet(L) = Results(j, k) Then
nSame = nSame + 1
Exit For
End If
Next L
If nSame > 4 Then
blNew = False
Exit For
End If
Next k
If Not blNew Then Exit For
Next j
End If

If blNew Then
nFound = nFound + 1
For k = 1 To 6
Results(nFound, k) = jSet(k)
Next k
End If

Next F
Next E
Next D
Next C
Next B
Application.StatusBar = nFound
Next A

Worksheets("Results").Range("B3").Resize(5000, 6) = Results
Application.StatusBar = False

End Sub

 

[Dana DeLouis]

Hi. Just a thought...

For F = E + 1 To 30

…do stuff

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


If we pick say variable F, then when we have a "success" with:
1-2-3-4-5-6

Then I believe there is no need to check F as it goes from 7 to 30.
Perhaps exit out of this loop at this time. This would reduce some
checking with just Variable F alone.

I'm a little confused with the statements: "4 or more", and "4 or Less"

Again, just an idea.

Dana DeLouis

 

[Ste Mac]

Thanks Charles and Dana.. I have only just got back from work, I look
forward to
using your suggestions, I will have a go tomorrow and let you guy's
know...

Charles, I will run your code and check the results against mine and
see if they compare.
Looking at your code, it will take me some time to try and understand
whats going on.

This is a very interesting.

Again, thank you very much for your help

Ste

 

[Charles Williams]

Good idea, seems to work : 2 min 20 sec on my system

I am sure this could be optimised even more!

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

 

[Ste Mac]

Absolutely amazing Charles... what a massive increase in speed,
fantastic... but I will be honest, to understand
the code I would have to sit here for months!

I also added Joel's tweak... clever, cheers Joel

I would never have looked at this way, it gives me a lot to look at
and think about.

Many many thanks for your help

Ste

 

[Dana DeLouis]

Just out of curiosity, what are the total number of unique solutions to
your problem of 30 numbers, taken 6 at a time, with no set having the
same 5 or 6 numbers?

Dana DeLouis

 

[Ste Mac]

Hi Dana, using Charles's code it generates 4539 unique sets.

It looks like its bang on the money, scanning down the sets I cannot
see any more than four number repeats... quite cool really...

Ste

 

[Dana DeLouis]

4539 unique sets

Hi. I may be wrong, but I show many more than that (in about 1 minute)

I'll just throw this out for consideration...
Our solutions start to diverge here:

You have...

1,2,3,4,29,30
1,2,3,4,8,9
1,2,3,5,10,11
1,2,3,5,12,13

I have...

1,2,3,4,29,30
1,2,3,5,7,9
1,2,3,5,8,10
1,2,3,5,11,13

and the differences grows from here.
Again, I may be wrong.

= = = = = = = =
Dana DeLouis

 

[Dana DeLouis]

Ahh. I have a small typo in the second line of your data.
Let me try again...

You have...

1,2,3,4,29,30
1,2,3,5,8,9
1,2,3,5,10,11
1,2,3,5,12,13

I have...

1,2,3,4,29,30
1,2,3,5,7,9
1,2,3,5,8,10
1,2,3,5,11,13

And the differences grow from here.
Still... I may be wrong.

Dana DeLouis

<snip>