Excel VBA process increases exponentially with more records toprocess

[mwilliams1216]

I have the following code running to create a mail merge file. The
Users sheet contains all the contact information. The FreeAccess sheet
contains the users' IDs and the contents for the mail merge fields.
There could be as many as 30 rows per user on this sheet. The code
searches for all the rows for each user on the Users sheet and copies
the contents of each row of the FreeAccess sheets for that user to the
user's single row on the Users sheet. The problem I'm running into is
that I can run 250 records in about 15 minutes. It will run 500
records in an hour and 1000 records in 4 hours. At this point it's
quicker for me to run these in batches of 250. Is there something I
can do to stop this exponential increase in processing time so that I
can run larger batches more efficiently?

Dim lngUserRow As Long
Dim lngAccessRow As Long
Dim lngcolumn As Long
Dim lngKOU As Long
Dim lngMaxColumn As Long
Dim lngBrokerCount As Long
Dim StrHeading As String
Dim lngUserCount As Long
Dim lngAccessCount As Long
Dim n As Long
Dim lngNewMaxColumn As Long
Dim LastRow As Long
Dim strBroker As String

'Get count of users with request responses.

Worksheets("Users").Activate
If Cells(3, 1) = "" Then
lngUserCount = 1
Else: Cells(2, 1).Select
Range(Selection, Selection.End(xlDown)).Select
lngUserCount = Selection.Count
End If

' Get count of accessible brokers.
Worksheets("Free Access").Activate
Cells(2, 1).Select
Range(Selection, Selection.End(xlDown)).Select
lngAccessCount = Selection.Count


'Get accessible brokers and match them up with the users on the Users
worksheet (in one row).

Worksheets("Free Access").Activate
Cells(2, 1).Select
Selection.End(xlDown).Select
LastRow = ActiveCell.Row

lngMaxColumn = 6
lngUserRow = 2

For lngUserRow = 2 To LastRow

Worksheets("Users").Activate
lngcolumn = 7
lngKOU = Cells(lngUserRow, 1).Value

For lngAccessRow = 2 To lngAccessCount + 1

Worksheets("Free Access").Activate

If Cells(lngAccessRow, 1).Value = lngKOU Then

strBroker = Cells(lngAccessRow, 2).Value
Worksheets("Users").Activate
Cells(lngUserRow, lngcolumn).Value = strBroker
lngcolumn = lngcolumn + 1

If lngcolumn > lngMaxColumn Then

lngMaxColumn = lngcolumn

End If

End If

If IsEmpty(Cells(3, 1)) Then
GoTo FINISH_HERE
End If

Next lngAccessRow

Next lngUserRow

 

[Keith74]

A quick solution may be to put

Application.screenupdating = false

at the start of the process, and

Application.screenupdating = true

at the very end.

hth

Keith

 

[mwilliams1216]

A quick solution may be to put

Application.screenupdating = false

at the start of the process, and

Application.screenupdating = true

at the very end.

hth

Keith

Thanks, Keith. I have that in there already - just posted the
relevant code. The rest of it is doing to formatting for column
headings, etc. The code I posted is where all the real work is being
done.

 

[Keith74]

Ok, option 2 is to re-code to get rid of the unnecessary .select
and .activate methods. To get info from the worksheets and ranges you
don't need to select/activate them, always slows things down.

e.g.

replace

Worksheets("Users").Activate
lngKOU = Cells(lngUserRow, 1).Value

with

Worksheets("Users").Cells(lngUserRow, 1).Value

hth

Keith