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