godspeed macro

[icestationzbra]

hi,

i have this macro, for which i would like some help in performanc
tuning. i work with a sheet which has 17 columns and 3500 rows an
growing. this macro mimics countif and sumproduct. it usually take
about 30 minutes for this thing to complete. is there something that
could to do inject it with some steroids?

i had one thing on mind, but i am not able to put it in code. thi
macro looks for projects along Column A of TaskReport. once all th
rows with a certain project has been identified, is there a way t
eliminate them from the search in the next loop? hope this makes sense
i dont know to play with arrays.

thanks,

mac.

*****

Sub Report()

Dim intAcc As Integer
Dim intRowsTR As Integer
Dim intRej As Integer
Dim intRowsPR As Integer
Dim intDef As Integer
Dim intCount As Integer
Dim intWIP As Integer

Dim m As Integer
Dim n As Integer

m = 2
n = 2
intRowsPR = 0
intRowsTR = 0
intAcc = 0
intRej = 0
intDef = 0
intCount = 0
intWIP = 0

intRowsTR = Sheet2.Range("A1").CurrentRegion.Rows.Count 'rows in th
TaskReport sheet

intRowsPR = Sheet3.Range("A1").CurrentRegion.Rows.Count 'rows in th
ProjectReport sheet

For n = 2 To intRowsPR

For m = 2 To intRowsTR

'If LCase(Sheet3.Range("K" & n)) = LCase("Y") Then 'picks up project
that are active

If (LCase(Sheet2.Range("A" + Trim(Str(m))))
LCase(Sheet3.Range("A" + Trim(Str(n))))) Then

intCount = intCount + 1

If (LCase(Sheet2.Range("I" + Trim(Str(m))))
LCase("Accepted")) Then

intAcc = intAcc + 1


Else

If (LCase(Sheet2.Range("I" + Trim(Str(m))))
LCase("Rejected")) Then

intRej = intRej + 1

intDef = intDef + Sheet2.Range("M" & m).Value

Else

If (LCase(Sheet2.Range("I" + Trim(Str(m))))
LCase("WIP")) Then

intWIP = intWIP + 1

intDef = intDef + Sheet2.Range("M" & m).Value

End If

End If

End If

Else

Sheet3.Range("B" & n & ":F" & n).Value = 0

End If

'End If 'picks up projects that are active

Next m

'If LCase(Sheet3.Range("K" & n)) = LCase("Y") Then 'fills up project
that are active

'entering data into cells
Sheet3.Range("B" & n).Value = intCount

Sheet3.Range("C" & n).Value = intAcc

Sheet3.Range("D" & n).Value = intRej

Sheet3.Range("E" & n).Value = intWIP

Sheet3.Range("F" & n).Value = intDef

'End If 'fills up projects that are active

'reinitialising variables
intCount = 0
intAcc = 0
intRej = 0
intWIP = 0
intDef = 0

'If MsgBox("Loop " & n, vbOKCancel) = vbCancel Then Exit Sub 'to cance
out while testing

Next n

End Su

 

[Bernie Deitrick]

I'm not going to try and follow your logic, but you are much better off
using actual worksheet functions than trying to emulate them. Using
functions, sorting, cutting, copying, pasting, filtering.... whatever, and
you are better off using native Excel capabilites than writing your own.

HTH,
Bernie
MS Excel MVP

 

[AlfD]

Hi!

I don't see anything changing in your workbook while you are doing th
report. Sounds normal enough...

Experiment:

Make a copy of your workbook.
Now copy the worksheet with all the formulae and Paste Special
--Values back on top of itself.

Now run the report.

Any better?

Al

 

[CLR]

Hi mac.........

One thing you might try is to run a regular Autofilter to select the rows
you wish to further process, then Copy and Paste them over to another sheet,
and then run subsequent operations on that new sheet which contains only
your selected data.......

hth
Vaya con Dios,
Chuck, CABGx3