Very slow Excel Macro

[MikiV]

Somebody please help. I have several excel spreadsheets which should be
combined and calculated in one document. I made macro to perform this
function but it is extremly slow (takes hours). I have tried everything,
maybe it just cannot go any faster because of the thousands of records that
it has to search and calculate.
Following is a small section of my code (the slowest sub), I have several
similar to this one. What it should do is go through all the records in tab
"RecordTable", search for all matching job codes and locations to specified
fields in the tab "Main Table", calculate the total count and input in
specified field in the "Main Table".
The code is correct, it's just way to slow. I have specified the "slow part"
below. Thanks in advance for any advice you can give me.

Private Sub CommandButton3_Click()
On Error Resume Next

Dim columncount As Integer
Dim columnnumber As Integer
Dim PCBOErowcount As Integer
Dim countMAINrow As Integer
Dim countAuthorized As Integer
Dim updateAuthorized As String
Dim matchjob As Integer
Dim findcolumns As Integer
Dim tablejobvalue As String
Dim jobvalue As String
Dim tablesitecount As Integer
Dim sitevalue As String
Dim headcount As String
Dim sitename As String
Dim numberofrecords As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Worksheets("RecordTable").Activate
Worksheets("RecordTable").Cells(2, 1).Activate
RecordTablerowcount = ActiveCell.CurrentRegion.Rows.Count

Worksheets("Main Table").Activate
Worksheets("Main Table").Cells(3, 1).Activate
countMAINrow = ActiveCell.CurrentRegion.Rows.Count - 1
Worksheets("Main Table").Cells(3, 3).Activate
columncount = ActiveCell.CurrentRegion.Columns.Count - 4

tablesitecount = 505
Worksheets("Main Table").Activate
Worksheets("Main Table").Cells(3, 3).Activate

For columnnumber = 3 To columncount
sitename = Worksheets("Main Table").Cells(tablesitecount, 2).Value

For countAuthorized = 3 To countMAINrow
tablejobvalue = Worksheets("Main Table").Cells(countAuthorized, 1).Value
numberofrecords = 0

''''''' Slow Part

For matchjob = 2 To RecordTablerowcount
jobvalue = Worksheets("RecordTable").Cells(matchjob, 10).Value
sitevalue = Worksheets("RecordTable").Cells(matchjob, 3).Value
headcount = Worksheets("RecordTable").Cells(matchjob, 13).Value
If jobvalue = tablejobvalue And sitevalue = sitename And headcount =
"1" Then
numberofrecords = numberofrecords + 1
End If

''''''' End of Slow Part

Next matchjob

Worksheets("Main Table").Cells(countAuthorized, columnnumber).Value =
numberofrecords

Next countAuthorized
tablesitecount = tablesitecount + 1
columnnumber = columnnumber + 3
Next columnnumber

ActiveWorkbook.Save

End Sub

 

[HelpExcel.com]

Miki,

Does it take a long time for response when you step through the code (i.e.,
press the F8 key)?

 

[Tim Zych]

Hmm, out of your macro, I would think the code which you say is slow to be
some of the faster code you have written.

Generally, to avoid slow code, don't activate or select anything unless
needed. Here is an alternative way to go about some of the code.

RecordTablerowcount = Worksheets("RecordTable").Cells(2,
1).CurrentRegion.Rows.Count
countMAINrow = Worksheets("Main Table").Cells(3,
1).CurrentRegion.Rows.Count - 1
columncount = Worksheets("Main Table").Cells(3,
3).CurrentRegion.Columns.Count - 4

tablesitecount = 505

For columnnumber = 3 To columncount
sitename = Worksheets("Main Table").Cells(tablesitecount, 2).Value

For countAuthorized = 3 To countMAINrow

tablejobvalue = Worksheets("Main Table").Cells(countAuthorized,
1).Value

numberofrecords = 0

With Worksheets("RecordTable")
For matchjob = 2 To RecordTablerowcount
jobvalue = .Cells(matchjob, 10).Value
sitevalue = .Cells(matchjob, 3).Value
headcount = .Cells(matchjob, 13).Value
If (jobvalue = tablejobvalue) And (sitevalue = sitename) And
(headcount = "1") Then
numberofrecords = numberofrecords + 1
End If
Next matchjob
End With

Worksheets("Main Table").Cells(countAuthorized, columnnumber).Value
= numberofrecords

Next countAuthorized


How many rows are being evaluated? Are the rows at the beginning of the
evaluation as slow as those at the end? Even a spreadsheet with 65,000 rows
should be quick. Something is seriously wrong for it to take hours. I would
imagine it should take a few seconds max per column.

Just try replacing the "slow part" with this modification.

With Worksheets("RecordTable")
For matchjob = 2 To RecordTablerowcount
jobvalue = .Cells(matchjob, 10).Value
sitevalue = .Cells(matchjob, 3).Value
headcount = .Cells(matchjob, 13).Value
If (jobvalue = tablejobvalue) And (sitevalue = sitename) And
(headcount = "1") Then
numberofrecords = numberofrecords + 1
End If
Next matchjob
End With

Does that make any difference? Also, is headcount really a string in the
spreadsheet, or a number?

Alternatively, try this modification, which evaluates headcount as a number
rather than a string and should be faster.

Dim headcount As Long

With Worksheets("RecordTable")
For matchjob = 2 To RecordTablerowcount
jobvalue = .Cells(matchjob, 10).Value
sitevalue = .Cells(matchjob, 3).Value
headcount = .Cells(matchjob, 13).Value
If (jobvalue = tablejobvalue) And (sitevalue = sitename) And
(headcount = 1) Then
numberofrecords = numberofrecords + 1
End If
Next matchjob
End With

 

[MikiV]

Yes... You can see the yelow line (steps) when you are holding F8...

 

[OssieMac]

Try replacing the slow code with the following code:-

numberofrecords = WorksheetFunction _
.CountIfs(Columns(10), "=" & tablejobvalue, _
Columns(3), "=" & sitename, _
Columns(13), "=1")

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

 

[MikiV]

First of all thank you for your effort and suggestions, I really appreciate
it... Unfortunately it didn't work... I really don't get it, I'm loosing my
mind here, everything looks correct but when I stop the code after like 10
seconds, only a dozen cells are updated... It doesn't make any sense... I
have 27000 rows in the other tab, and 13 columns...
Do you have any other ideas????

 

[MikiV]

No change, except it was returning 0 values with the same slow speed ...

 

[Tim Zych]

From the way you describe it, it looks like calculation is occurring after
each update, but from your code sample, you have turned calculation off.

During the line

is calculation really off? Perhaps some other process has turned it on.

Put a breakpoint on that line, then when the macro stops there, in the
immediate window type.

?application.Calculation =xlCalculationManual

Is it True?

 

[MikiV]

Calculation is off Tim, I tried it several times (after few steps).
I don't get it, it takes like 30min to calculate if I use excel formulas
(sumif, countif etc) but it takes much longer with VB code when actually
should be faster... Doesn't make any sense... Any other ideas???

?application.Calculation = xlCalculationManual
True
True
True
True
True

 

[Tim Zych]

I'm stumped.

What happens with various tests with this block of code:

With Worksheets("RecordTable")
For matchjob = 2 To RecordTablerowcount
jobvalue = .Cells(matchjob, 10).Value
sitevalue = .Cells(matchjob, 3).Value
headcount = .Cells(matchjob, 13).Value

If (jobvalue = tablejobvalue) And (sitevalue = sitename) And
(headcount = "1") Then
numberofrecords = numberofrecords + 1
End If
Next matchjob
End With

Worksheets("Main Table").Cells(countAuthorized, columnnumber).Value
= numberofrecords

Such as

With Worksheets("RecordTable")
For matchjob = 2 To RecordTablerowcount
jobvalue = '<some hardcoded jobvalue>'
sitevalue = '<some site value'
headcount = '<some head count>'

If 1 = 1 Then
numberofrecords = numberofrecords + 1
End If
Next matchjob
End With

' Worksheets("Main Table").Cells(countAuthorized, columnnumber).Value
= numberofrecords

 

[OssieMac]

Yes my error. It would not have been counting on the correct worksheet and
hense the zero value.

I would like to set up a dummy test. Can you provide me with a little more
info.
How many rows of data do you have?
In a test with your code what does numberofrecords return.

If I set it up with the approximate number of rows and approximate number of
records that should be returned then testing is more reliable.

In the mean time you could try the following code which restricts the
countifs to the actual range instead of the entire column. Also I have
included the correct worksheet this time.

Dim rng10 As Range
Dim rng3 As Range
Dim rng13 As Range

With Worksheets("RecordTable")
Set rng10 = .Range(.Cells(2, 10), _
.Cells(matchjob, 10))
Set rng3 = .Range(.Cells(2, 3), _
.Cells(matchjob, 3))
Set rng13 = .Range(.Cells(2, 13), _
.Cells(matchjob, 13))
End With

numberofrecords = WorksheetFunction _
.CountIfs(rng10, "=" & tablejobvalue, _
rng3, "=" & sitename, _
rng13, "=1")

 

[Patrick Molloy]

maybe test headcount first ... and switch off screenupdating

is headcount DIM'd as long or string? I assume lond, so not = "1" but just
=1

With Worksheets("RecordTable")

For matchjob = 2 To RecordTablerowcount
headcount = .Cells(matchjob, 13).Value

IF headcount = 1 then

jobvalue = .Cells(matchjob, 10).Value
sitevalue = .Cells(matchjob, 3).Value

If (jobvalue = tablejobvalue) And (sitevalue = sitename)
Then
numberofrecords = numberofrecords + 1
End If

end if

 

[Mike Fogleman]

Dim headcount As String
is in the original post

Mike F

 

[MikiV]

Thank you for trying to help Ossie, I will break my PC if I don't figure this
out ...
I've tried your idea and it didn't work out.

Here is how the code is set up comparing to the table tab and tab with
records:

“Main Table†contains only table where data should be calculated: Columns
A-DB (columncount); Rows 423 (countMAINrow)
“Recordtable†contains all the records: Columns A-Q (not set up in code – no
need); Rows 27000 (RecordTablerowcount)

tablesitecount = 505 shows the number of the row on “Main Table†where the
name of worksite is located, other sites are below until row 529
On the “main Table†columns are matching the site as follows:

C:F = site located on 505
G:J = site located on 506
K:N = site located on 507 and so far and so on…

For columnnumber 3 to columncount – (3 to 102)
For countauthorized 3 to countmainrow – (3 to 423)
For Matchjob 2 to recordtablecount – (2 to 27000)

tablesitecount = tablesitecount + 1 (takes you to the next site after
for-next)
columnnumber = columnnumber + 3 (skips 3 columns after for-next because they
are populated later with different code)

 

[MikiV]

Mike, Patrick

I've completely removed headcount and still no change... Maybe I just have
too many records and the code cannot work faster, or I was stupid enough to
make this code in incorrect order... These are the values of columns/rows:

For columnnumber 3 to columncount – (3 to 102) columns in "Main Table"
For countauthorized 3 to countmainrow – (3 to 423) rows in "Main Table"
For Matchjob 2 to recordtablecount – (2 to 27000) records in "recordtable"

 

[Patrick Molloy]

how about a change? Listen, using array formula resolves a lot of the
slowness if FOR/NEXT loops

so what I did was replace you With Worksheets("RecordTable") /END WITH
statement
I range named the table column for the jobs (column 10) as "jobs", for the
sites (column 3) as "sites" and for headcount (column 13) as "heads"
I've used cell A1 for the answer
The idea is to push into A1 the array formula, amended for the site/job we
want to count and return that to the code.....

Option Explicit
Sub demo()
MsgBox HeadCount("A", "B")
End Sub

Function HeadCount(tablejobvalue As String, sitename As String) As Long
Dim rCount As Range ' for the resulting array formulae
Set rCount =Worksheets("RecordTable").Range("A1")
rCount.FormulaArray = "=Sum((Jobs = """ & tablejobvalue & """) *
(Sites = """ & sitename & """) * (Heads = 1))"
HeadCount = rCount.Value
End Function

 

[keiji kounoike]

I'm not sure this would work in your side and also not sure faster than
your code, but try this.

Sub SomeCommandButton()
'On Error Resume Next
Dim columncount As Long
Dim columnnumber As Long
'Dim PCBOErowcount As Long
Dim countMAINrow As Long
Dim countAuthorized As Long
'Dim updateAuthorized As String
'Dim findcolumns As Long
Dim tablejobvalue As String
Dim jobvalue As String
Dim tablesitecount As Long
Dim sitevalue As String
Dim headcount As String
Dim sitename As String
Dim numberofrecords As Long
Dim RecordTablerowcount As Long
Dim Ncell As Range, rng As Range
Dim firstaddress As String
Dim Mainsh As Worksheet, Recordsh As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Set Recordsh = Worksheets("RecordTable")
With Recordsh
RecordTablerowcount = .Cells(2, 1).CurrentRegion.Rows.Count
Set rng = .Range(.Cells(2, 3), .Cells(RecordTablerowcount - 2 + 1, 3))
End With

Set Mainsh = Worksheets("Main Table")
With Mainsh
countMAINrow = .Cells(3, 1).CurrentRegion.Rows.Count - 1
columncount = .Cells(3, 3).CurrentRegion.Columns.Count - 4
End With
tablesitecount = 505

For columnnumber = 3 To columncount
sitename = Mainsh.Cells(tablesitecount, 2).Value
If sitename = "" Then
Exit For
End If
For countAuthorized = 3 To countMAINrow
tablejobvalue = Mainsh.Cells(countAuthorized, 1).Value
numberofrecords = 0
Set Ncell = rng.Find _
(sitename, LookIn:=xlValues, lookat:=xlWhole)
If Not Ncell Is Nothing Then
firstaddress = Ncell.Address
Do
jobvalue = Recordsh.Cells(Ncell.Row, 10).Value
headcount = Recordsh.Cells(Ncell.Row, 13).Value
If jobvalue = tablejobvalue And headcount = "1" Then
numberofrecords = numberofrecords + 1
End If
Set Ncell = rng.FindNext(Ncell)
Loop While Not Ncell Is Nothing _
And Ncell.Address <> firstaddress
End If
Mainsh.Cells(countAuthorized, columnnumber).Value = numberofrecords
Next countAuthorized
tablesitecount = tablesitecount + 1
columnnumber = columnnumber + 3
Next columnnumber
ActiveWorkbook.Save
End Sub

Keiji

 

[Tim Zych]

Did you try my last idea? I think you still need to isolate what the problem
really is. Most of the code improvements are valid. The fact they don't work
quickly on your system is what should be explored more.

 

[Patrick Molloy]

if its not possible to isolate the issue, and from the length of this thread
that's a possibility, then i see no reason not to offer a reasonable
alternative. Nor is it "my" system that's the issue ...

Did you try my last idea? I think you still need to isolate what the
problem really is. Most of the code improvements are valid. The fact they
don't work quickly on your system is what should be explored more.

--
Regards,
Tim Zych
http://www.higherdata.com
Workbook Compare - Excel data comparison utility

<<< SNIP >>>

 

[Tim Zych]

Yup. As long as the OP understands that there may not be a causal
relationship between something that looks faster and the solution to the
root of the problem. From the way the latter half of the thread was
progressing, it seemed that the underlying problems were starting to get
ignored. I have seen it time and again where developers get involved in
similar predicaments, try this..try that..try the other thing...to the Nth
degree....then arrive at a final solution where they categorically embrace
or reject some Excel objects or coding styles based on false assumptions.
Just trying to keep that in check...