For each cell method, is there a much faster way?

S

ste mac

Hi, I have a lot of records to search thru', everything works fine,
its just this section of code below is far too slow.

Is there any way to make this section of code work at sub light speed
or even light speed?

thanks for any help

Ste

Do While Not (Sheets("Meetingstodate").Cells(xlrow, 2).Value = "")

Set StartCell = Sheets("Meetingstodate").Cells(xlrow, 2)
Set EndCell = Sheets("Meetingstodate").Cells(xlrow, 7)

For Each cell In Range(StartCell, EndCell)

If cell.Value = A Then
intcounter1 = 1
End If
If cell.Value = B Then
intcounter2 = 1
End If
If cell.Value = C Then
intcounter3 = 1
End If
If cell.Value = D Then
intcounter4 = 1
End If
If cell.Value = E Then
intcounter5 = 1
End If
If cell.Value = F Then
intcounter6 = 1
End If

Next cell

If intcounter1 + intcounter2 + intcounter3 + intcounter4 + intcounter5
+ intcounter6 >= 5 Then
totcounter = totcounter + 1
End If

xlrow = xlrow + 1

Loop
 
G

Gary''s Student

Light speed is tough!

But rather than using cell.Value repeatedly, use a correctly Dimm'ed variable:
v=cell.Value

Also use a Case in place of the bunch of Ifs. That way the extra statements
don't need to be executed.
 
G

Gary''s Student

Something like:

'Dim v as whatever A,B,C,... are
v = cell.Value
Select Case v
Case A
intcounter1 = 1
Case B
intcounter2 = 1
Case C
intcounter3 = 1
Case D
intcounter4 = 1
Case E
intcounter5 = 1
Case F
intcounter6 = 1
End Select

The speed will improve a little. Like I said; light speed is tough.
 
S

ste mac

Thanks Gary''s Student, I just tried your improvement and it it
definately quicker no doubt about it.

A welcome improvement.

I will have another trawl through this ng and see if it cab be further
improved.

Thanks alot...

Ste
 
P

Peter T

I don't quite understand why your totcounter counter gets incremented that
way, but in general if you want to loop values of a large number of cells,
assign the entire range.Value to an array and loop the array

arr = Range("A1:D100").Value

for r = 1 to ubound(arr)
for c = 1 to ubound(arr, 2)

select case arr(r, c)
case A: intcounter1 = 1 ' ?
etc
end select
' code
next
next

Perhaps in your case though you could use the CountIf worksheet function for
each of your A, B, C values

Regards,
Peter T
 
N

NOPIK

Do
set WhatFound=Range(StartCell, EndCell).Find(A, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=False)
If Not (WhatFound Is Nothing) then
'Action A
End If
Loop Until WhatFound Is Nothing
Do
set WhatFound=Range(StartCell, EndCell).Find(B, LookIn:=xlValues,
LookAt:=xlWhole, MatchCase:=False)
If Not (WhatFound Is Nothing) then
'Action B
End If
Loop Until WhatFound Is Nothing
 
S

ste mac

Hi Pete, the totcounter was the only way I could think of of counting
if five or more people were found :

"If intcounter1 + intcounter2 + intcounter3 + intcounter4 +
intcounter5 + intcounter6 >= 5 Then"

Is there a better way? as long as the answer is 5 or more then it can
execute the rest of the code

I will stick your code in and see if it speeds up

Thanks a lot

Ste
 
S

ste mac

Peter, I get an error, I have'nt got the syntax right, should your
code look like this?

Error: Ubound "Expected array"

ste

Dim arr As Range
Dim r As Range
Dim s As Range 'correct Dim's?

Do While Not (Sheets("Meetingstodate").Cells(xlrow, 2).Value = "")

Set StartCell = Sheets("Meetingstodate").Cells(xlrow, 2)
Set EndCell = Sheets("Meetingstodate").Cells(xlrow, 7)

arr = Range(StartCell, EndCell).Value

For r = 1 To UBound(arr)
For s = 1 To UBound(arr, 2)

Select Case arr(r, s)
Case A
intcounter1 = 1
Case B
intcounter2 = 1
Case C
intcounter3 = 1
Case D
intcounter4 = 1
Case E
intcounter5 = 1
Case F
intcounter6 = 1
' code
Next
Next
 
P

Peter T

I still don't get your counter stuff or that "Do While" but try the
following (obviously it's incomplete)

Sub Test2()
Dim arr As Variant
Dim j As Long
Dim k As Long 'correct Dim's?
Dim xlRow As Long
Dim intcounter1&, intcounter2&, intcounter3&
Dim intcounter4&, intcounter5&, intcounter6&
Dim StartCell As Range, EndCell As Range
Dim A, B, C, D, E, F

' Do While Not (Sheets("Meetingstodate").Cells(xlRow, 2).Value = "")

'' code to get xlRow, but not that "Do While" code above
'' whatever that's supposed to do.

xlRow = 100 ' just for testing

Set StartCell = Sheets("Sheet1").Cells(xlRow, 2)
Set EndCell = Sheets("Sheet1").Cells(xlRow, 7)

arr = Range(StartCell, EndCell).Value
MsgBox Range(StartCell, EndCell).Address ' just for testing

For j = 1 To UBound(arr)
For k = 1 To UBound(arr, 2)

Select Case arr(j, k)
Case A
intcounter1 = 1
Case B
intcounter2 = 1
Case C
intcounter3 = 1
Case D
intcounter4 = 1
Case E
intcounter5 = 1
Case F
intcounter6 = 1
End Select

Next
Next

End Sub

Probably best to not to assign more than 1 to 200,000 cell values to an
array, if necessary process in chuncks.

Regards,
Peter T
 
K

kounoike

I don't quite understand your logic and I know this code is not the same
logic as yours.
but i think this one might be a little faster than yours.

Sub test()
Dim xlrow As Long, lastrow As Long
Dim totcounter As Long, s As Long
Dim Startcell As Range, Endcell As Range, rng As Range
Dim r

xlrow = 2
Set Startcell = Cells(xlrow, 2)
Set Endcell = Cells(xlrow, 7)
Set rng = Range(Startcell, Endcell)

lastrow = Cells(xlrow, 2).End(xlDown).Row

For xlrow = 2 To lastrow
For Each r In Array("A", "B", "C", "D", "E", "F")
If Application.CountIf(rng, r) >= 1 Then
s = s + 1
End If
Next
If s >= 5 Then
totcounter = totcounter + 1
End If
s = 0
Set rng = rng.Offset(1, 0)
Next
MsgBox totcounter
End Sub

keiji
 
S

ste mac

Peter, well done mate...

My method was running at 160 per minute,
Gary''s Student pushed it up to 400 per min
You pushed it up to 580 per min... nice one

Sweet...

Do I need to use

'If intcounter1 + intcounter2 + intcounter3 + intcounter4 +
intcounter5 + intcounter6 >= 5 Then'

I get the feeling you would not employ this? is this slowing it down?

Ste
 
P

Peter T

Afraid I don't follow the objective of the loop and those counters, however
that "If" line is trivial in comparison to looping and reading a single
cell.

I haven't looked at GS's but with a large number of cells involved I'd
expect speed to increase considerably more than the 160:580 ratio you
indicate, by assigning values to an array vs looping cells. Depending on
what you are doing overall a 1:100 improvement would not be unexpected.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top