This is a bit verbose but no debugging is required. Both macros work.

The problem is that each time I run the below ApplyFilter macro and then the
RemoveFilter macro, execution becomes progressively slower. It is only
apparent when there is a lot of data being filtered (which is normally the
case). The problem is much worse using xl2002 versus xl2000. When I monitor
the memory usage of Excel.exe through the Task Manager it becomes
progressively larger. When I close and reopen the workbook it reverts to
normal. Note that I take care to destroy the range variables at the end of
each to no avail. Using API code to clear the clipboard and setting
CutCopyMode to False dont help either. I don't think using Cut with this
syntax involves the clipboard anyway.

Theres a reason I dont just hide and unhide rows to accomplish filtering
and unfiltering (or use AutoFilter) but Ill not go into that here. This is
an important part of a large and project so Im quite concerned. Hoping
someone has encountered this before and has a solution. Very appreciative of
your assisatance.

Sub ApplyFilter(Filter As String, SearchType As String)
Dim rng As Range, rng2 As Range, ar As Range
Dim rw As Long
Dim i As Integer
Dim ScrArea As String

On Error GoTo ProcExit
Filter = Trim(Filter)
Application.ScreenUpdating = False
With MainWks
ScrArea = .ScrollArea
.ScrollArea = ""
With Intersect(.UsedRange, .Range("D:F"))
Set SearchCell = .Find(Filter, LookAt:=LookAtType, MatchCase:=MchCase)
If Not SearchCell Is Nothing Then
rw = SearchCell.Row
If SearchCell(1, 0) = SearchType Then
Set rng = FormatRegion(SearchCell, SheetBackColor)
Set rng2 = rng.Resize(rng.Rows.Count + 3, 33)
End If
Do
Set SearchCell = .FindNext(SearchCell)
If Not SearchCell Is Nothing Then
If SearchCell(1, 0) = SearchType Then
Set rng = FormatRegion(SearchCell, SheetBackColor)
Set rng = rng.Resize(rng.Rows.Count + 3, 33)
If rng2 Is Nothing Then Set rng2 = rng Else Set rng2
= Union(rng2, rng)
End If
Else
Exit Do
End If
Loop While SearchCell.Row rw
End If
End With
If rng2 Is Nothing Then
Call FailedSearchMsg(1, Filter, SearchType)
Else
With .Range("A2:AF" & .UsedRange.Rows.Count + 1)
.Rows.Hidden = True
rng2.EntireRow.Hidden = False
.Cut .Range("AJ1")
For Each ar In rng2.Areas
ar.Offset(0, 35).Cut ar(1, 1)
Next
End With
With Application.CommandBars(1).Controls(ProgTitle)
.Controls(1).Enabled = False
.Controls(10).Enabled = True
End With
FiltApplied = True
For i = 1 To 5
Me.Controls("CommandButton" & i).Enabled = (i = 5)
Next
Union(.Columns(2), .Columns(16)).Font.Color = vbBlack
End If
ProcExit:
.ScrollArea = ScrArea
.Protect UserInterfaceOnly:=True
End With
Set ar = Nothing
Set rng = Nothing
Set rng2 = Nothing
If ActiveCell.EntireRow.Hidden Then Call GoToFirstUnhidden
ActiveWindow.ScrollRow = 1
'Beep
Application.ScreenUpdating = True
End Sub

Sub RemoveFilter()
Dim rw As Range, rng As Range, ar As Range
Dim ScrArea As String

Application.ScreenUpdating = False
With Application.CommandBars(1).Controls(ProgTitle)
.Controls(10).Enabled = False
.Controls(1).Enabled = True
End With
With MainWks
.Unprotect
ScrArea = .ScrollArea
.ScrollArea = ""
For Each rw In .UsedRange.EntireRow
If rw.Hidden = True Then
If rng Is Nothing Then Set rng = rw.Resize(1, 33) Else _
Set rng = Union(rng, rw.Resize(1, 33))
End If
Next
If Not rng Is Nothing Then
For Each ar In rng.Areas
ar.Offset(0, 35).Cut ar(1, 1)
Next
End If
.Rows.Hidden = False
Union(.Columns(2), .Columns(16)).Font.Color = SheetBackColor
.ScrollArea = ScrArea
.Protect UserInterfaceOnly:=True
End With
Application.ScreenUpdating = True
FiltApplied = False
Set rng = Nothing
Set rw = Nothing
End Sub