Memory problem (I think ???)
 

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

Memory problem (I think ???)
 

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

Thanks Jim for your time. I tried your suggestion in spite of the fact that
no page breaks show after execution. It was not successful.

At the start, Excel.exe memory usage is 36.4 meg and after about six
executions of the two macros it grows to about 42 meg. Execution time
increases eponentially, starting at slightly over 1 second to approx. 12
seconds after six executions. The problem is an order of magnitude worse
using xl2002 for some reason. An earlier version that inserted cells to move
the contents rather than using Cut was worse.

I've seen a post implicating the Union method for causing slow execution but
only (as memory serves) after approx. 400 noncontiguous ranges are involved.
This is not the case here. I might try tagging the ranges, say with the
letter "x", and using SpecialCells instead of Union. I'm not at all
optimistic though.

The reason I use this complex filter/unfilter method is that achieving this
by simply hiding/unhiding rows results in thousands of rows fitting inside
the visible range due to the row compression. In my case, there are lots of
different formats within the filtered ranges and Excel apparently still
paints the contents of hidden rows. This results in very poor performance
when scrolling. Therefore, I boot the contents outside of the visible range
after hiding the rows. I then put back the contents I want to show. The
problem was very profound and is completely fixed by this approach so I don't
doubt my theory. However, just in case you or someone else has a better
solution to the scroll problem, this would be much better than fixing the
other problem.

By the way, I did manually tag the ranges I want to display with the letter
"x" and used Excel's Autofilter to make sure it wasn't just an artifact of my
own filter. I confirmed that Autofilter had the same problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

Hi Greg,

there are lots of different formats within the filtered ranges and Excel apparently
still paints the contents of hidden rows. This results in very poor performance
when scrolling.

Perhaps you could try using the Advanced Filter. It can copy the "hits"
(including their formats) to a different section of the worksheet whilst
leaving the database intact.


Regards,
Vic Eldridge




"Greg Wilson" wrote:

Thanks Jim for your time. I tried your suggestion in spite of the fact that
no page breaks show after execution. It was not successful.

At the start, Excel.exe memory usage is 36.4 meg and after about six
executions of the two macros it grows to about 42 meg. Execution time
increases eponentially, starting at slightly over 1 second to approx. 12
seconds after six executions. The problem is an order of magnitude worse
using xl2002 for some reason. An earlier version that inserted cells to move
the contents rather than using Cut was worse.

I've seen a post implicating the Union method for causing slow execution but
only (as memory serves) after approx. 400 noncontiguous ranges are involved.
This is not the case here. I might try tagging the ranges, say with the
letter "x", and using SpecialCells instead of Union. I'm not at all
optimistic though.

The reason I use this complex filter/unfilter method is that achieving this
by simply hiding/unhiding rows results in thousands of rows fitting inside
the visible range due to the row compression. In my case, there are lots of
different formats within the filtered ranges and Excel apparently still
paints the contents of hidden rows. This results in very poor performance
when scrolling. Therefore, I boot the contents outside of the visible range
after hiding the rows. I then put back the contents I want to show. The
problem was very profound and is completely fixed by this approach so I don't
doubt my theory. However, just in case you or someone else has a better
solution to the scroll problem, this would be much better than fixing the
other problem.

By the way, I did manually tag the ranges I want to display with the letter
"x" and used Excel's Autofilter to make sure it wasn't just an artifact of my
own filter. I confirmed that Autofilter had the same problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

Greg,

my guess on why it gets progressively slower
is caused by the union command.

using union is ok if the multiarea has 300 or so
areas. Above that it seems to bog down.

Add a check to verify the area count of the range.
if 300 then "flush" the union either by processing it's areas,
or by "parking it" in a collection.

:
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Greg Wilson wrote in


Thanks Jim for your time. I tried your suggestion in spite of the
fact that no page breaks show after execution. It was not successful.

At the start, Excel.exe memory usage is 36.4 meg and after about six
executions of the two macros it grows to about 42 meg. Execution time
increases eponentially, starting at slightly over 1 second to approx.
12 seconds after six executions. The problem is an order of magnitude
worse using xl2002 for some reason. An earlier version that inserted
cells to move the contents rather than using Cut was worse.

I've seen a post implicating the Union method for causing slow
execution but only (as memory serves) after approx. 400 noncontiguous
ranges are involved. This is not the case here. I might try tagging
the ranges, say with the letter "x", and using SpecialCells instead
of Union. I'm not at all optimistic though.

The reason I use this complex filter/unfilter method is that
achieving this by simply hiding/unhiding rows results in thousands of
rows fitting inside the visible range due to the row compression. In
my case, there are lots of different formats within the filtered
ranges and Excel apparently still paints the contents of hidden rows.
This results in very poor performance when scrolling. Therefore, I
boot the contents outside of the visible range after hiding the rows.
I then put back the contents I want to show. The problem was very
profound and is completely fixed by this approach so I don't doubt my
theory. However, just in case you or someone else has a better
solution to the scroll problem, this would be much better than fixing
the other problem.

By the way, I did manually tag the ranges I want to display with the
letter "x" and used Excel's Autofilter to make sure it wasn't just an
artifact of my own filter. I confirmed that Autofilter had the same
problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

Thanks Vic for your help.

You probably recall the lab information management program (LIMS) that I
posted several months back which you responded to. This is that project. I
work on it only in my spare time.

The filtered ranges are shaded multi-row ranges that serve as "Lab Order"
forms and each multi-row range is treated as a unit. Filtering involves
either hiding or showing these ranges. Also, there is a great deal of
worksheet event code behind it that I want to remain functional for the
filtered data. So it would require duplication of this code if I were to copy
the "hits" and move them elsewhere. And changes made to these filtered Lab
Orders need to be reflected in the source Lab Orders. This is why I resorted
to the Cut method instead. I cut all data and move it outside of the visible
range and then put back the minority that I want to view.

For the reasons described above, I don't think Advanced Filter can be used.
I do intend to study up on it though. I'm only familiar with AutoFilter. It
looks very useful.

Thanks again Vic.

Greg





"Vic Eldridge" wrote:

Hi Greg,

there are lots of different formats within the filtered ranges and Excel apparently
still paints the contents of hidden rows. This results in very poor performance
when scrolling.

Perhaps you could try using the Advanced Filter. It can copy the "hits"
(including their formats) to a different section of the worksheet whilst
leaving the database intact.


Regards,
Vic Eldridge




"Greg Wilson" wrote:

Thanks Jim for your time. I tried your suggestion in spite of the fact that
no page breaks show after execution. It was not successful.

At the start, Excel.exe memory usage is 36.4 meg and after about six
executions of the two macros it grows to about 42 meg. Execution time
increases eponentially, starting at slightly over 1 second to approx. 12
seconds after six executions. The problem is an order of magnitude worse
using xl2002 for some reason. An earlier version that inserted cells to move
the contents rather than using Cut was worse.

I've seen a post implicating the Union method for causing slow execution but
only (as memory serves) after approx. 400 noncontiguous ranges are involved.
This is not the case here. I might try tagging the ranges, say with the
letter "x", and using SpecialCells instead of Union. I'm not at all
optimistic though.

The reason I use this complex filter/unfilter method is that achieving this
by simply hiding/unhiding rows results in thousands of rows fitting inside
the visible range due to the row compression. In my case, there are lots of
different formats within the filtered ranges and Excel apparently still
paints the contents of hidden rows. This results in very poor performance
when scrolling. Therefore, I boot the contents outside of the visible range
after hiding the rows. I then put back the contents I want to show. The
problem was very profound and is completely fixed by this approach so I don't
doubt my theory. However, just in case you or someone else has a better
solution to the scroll problem, this would be much better than fixing the
other problem.

By the way, I did manually tag the ranges I want to display with the letter
"x" and used Excel's Autofilter to make sure it wasn't just an artifact of my
own filter. I confirmed that Autofilter had the same problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

I hope you're right about the Union command. My code uses union to splice
hundreds of multi-row ranges together, but most of these are also contiguous.
So the actual number of areas involved is small - i.e. one more than the
number of "hits", or typically in the order of ten or so.

Q1 Perhaps Union gets bogged down by the total number of added ranges as
opposed to resultant areas ???

Q2 I didn't understand what you meant by processing the areas. My code does
this:

< If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Union(rng2, rng)
'more code
< For Each ar In rng2.Areas
< ar.Offset(0, 35).Cut ar(1, 1)
< Next

Q3 I didn't understand what you meant by "parking it" in a collection. Did
you mean add the ranges to a collection instead of using Union to splice
them. If this is the case then I would need to process each item in the
collection (hundreds) as opposed to each area in the spliced range (approx.
10) created by Union.

Regards,
Greg




"keepITcool" wrote:

Greg,

my guess on why it gets progressively slower
is caused by the union command.

using union is ok if the multiarea has 300 or so
areas. Above that it seems to bog down.

Add a check to verify the area count of the range.
if 300 then "flush" the union either by processing it's areas,
or by "parking it" in a collection.

:
--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Greg Wilson wrote in


Thanks Jim for your time. I tried your suggestion in spite of the
fact that no page breaks show after execution. It was not successful.

At the start, Excel.exe memory usage is 36.4 meg and after about six
executions of the two macros it grows to about 42 meg. Execution time
increases eponentially, starting at slightly over 1 second to approx.
12 seconds after six executions. The problem is an order of magnitude
worse using xl2002 for some reason. An earlier version that inserted
cells to move the contents rather than using Cut was worse.

I've seen a post implicating the Union method for causing slow
execution but only (as memory serves) after approx. 400 noncontiguous
ranges are involved. This is not the case here. I might try tagging
the ranges, say with the letter "x", and using SpecialCells instead
of Union. I'm not at all optimistic though.

The reason I use this complex filter/unfilter method is that
achieving this by simply hiding/unhiding rows results in thousands of
rows fitting inside the visible range due to the row compression. In
my case, there are lots of different formats within the filtered
ranges and Excel apparently still paints the contents of hidden rows.
This results in very poor performance when scrolling. Therefore, I
boot the contents outside of the visible range after hiding the rows.
I then put back the contents I want to show. The problem was very
profound and is completely fixed by this approach so I don't doubt my
theory. However, just in case you or someone else has a better
solution to the scroll problem, this would be much better than fixing
the other problem.

By the way, I did manually tag the ranges I want to display with the
letter "x" and used Excel's Autofilter to make sure it wasn't just an
artifact of my own filter. I confirmed that Autofilter had the same
problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

See following demos.
the 1st shows it takes around 40secs for a 2000 area range.
the 2nd uses a collection and takes around 3 seconds for the full
monty.
(each item in the collection holds a 96 area range)

be aware that if you start cutting and deleting
that you should enumerate the collection from END to BEGIN with STEP -1



Sub BogDemo()
Dim i&, s%, t!, r As Range
For s = 1 To 2
t = Timer
For i = 1 To Choose(s, Rows.Count, 4000) Step s
If r Is Nothing Then
Set r = Rows(i)
Else
Set r = Union(r, Rows(i))
End If
Next
MsgBox Timer - t & "Step" & s & " " & "Areas" & r.Areas.Count
Set r = Nothing
Next
End Sub

Sub ColDemo()
Dim i&, t!, r As Range, c As Collection
t = Timer
Set c = New Collection
For i = 1 To Rows.Count Step 2
If r Is Nothing Then
Set r = Rows(i)
Else
Set r = Union(r, Rows(i))
If r.Areas.Count = 96 Then
c.Add r
Set r = Nothing
End If
End If
Next

MsgBox Timer - t & vbLf & "Collection holds " & _
c.Count & " multiarea ranges of 96 areas"
End Sub


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Greg Wilson wrote in


I hope you're right about the Union command. My code uses union to
splice hundreds of multi-row ranges together, but most of these are
also contiguous. So the actual number of areas involved is small -
i.e. one more than the number of "hits", or typically in the order of
ten or so.

Q1 Perhaps Union gets bogged down by the total number of added
ranges as opposed to resultant areas ???

Q2 I didn't understand what you meant by processing the areas. My
code does this:

< If rng2 Is Nothing Then Set rng2 = rng Else Set rng2 = Union(rng2,
rng) 'more code
< For Each ar In rng2.Areas
< ar.Offset(0, 35).Cut ar(1, 1)
< Next

Q3 I didn't understand what you meant by "parking it" in a
collection. Did you mean add the ranges to a collection instead of
using Union to splice them. If this is the case then I would need to
process each item in the collection (hundreds) as opposed to each
area in the spliced range (approx. 10) created by Union.

Regards,
Greg




"keepITcool" wrote:

Greg,

my guess on why it gets progressively slower
is caused by the union command.

using union is ok if the multiarea has 300 or so
areas. Above that it seems to bog down.

Add a check to verify the area count of the range.
if 300 then "flush" the union either by processing it's areas,
or by "parking it" in a collection.

:
--
keepITcool
www.XLsupport.com | keepITcool chello nl | amsterdam


Greg Wilson wrote in


Thanks Jim for your time. I tried your suggestion in spite of the
fact that no page breaks show after execution. It was not
successful.

At the start, Excel.exe memory usage is 36.4 meg and after about
six executions of the two macros it grows to about 42 meg.
Execution time increases eponentially, starting at slightly over
1 second to approx. 12 seconds after six executions. The problem
is an order of magnitude worse using xl2002 for some reason. An
earlier version that inserted cells to move the contents rather
than using Cut was worse.

I've seen a post implicating the Union method for causing slow
execution but only (as memory serves) after approx. 400
noncontiguous ranges are involved. This is not the case here. I
might try tagging the ranges, say with the letter "x", and using
SpecialCells instead of Union. I'm not at all optimistic though.

The reason I use this complex filter/unfilter method is that
achieving this by simply hiding/unhiding rows results in
thousands of rows fitting inside the visible range due to the row
compression. In my case, there are lots of different formats
within the filtered ranges and Excel apparently still paints the
contents of hidden rows. This results in very poor performance
when scrolling. Therefore, I boot the contents outside of the
visible range after hiding the rows. I then put back the
contents I want to show. The problem was very profound and is
completely fixed by this approach so I don't doubt my theory.
However, just in case you or someone else has a better solution
to the scroll problem, this would be much better than fixing the
other problem.

By the way, I did manually tag the ranges I want to display with
the letter "x" and used Excel's Autofilter to make sure it wasn't
just an artifact of my own filter. I confirmed that Autofilter
had the same problem.

Thanks again Jim.

Greg







"Jim Cone" wrote:

Greg,

Try setting your worksheet .DisplayPageBreaks property to False
every time after hiding or showing a row.

Regards,
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Greg Wilson"
wrote in message...
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

Memory problem (I think ???)
 

Thanks keepITcool. That's very interesting. Unfortunately, I don't think it
is responsible for my problem however. There are only typically about 10
areas involved. I intend to experiment with your suggestion just in case
there is some interaction with the issue you describe and some unknown.

I experimented with not using the Cut method and only hiding/unhiding rows
(i.e. conventional filter/unfilter) and left the Union code the same.
Execution was excellent (< 1 sec) and it did not become progressively slower
with multiple executions. This seems to prove that it is the Cut method that
is the problem. It was also worse when I inserted/deleted cells to move the
contents in an earlier version. As I mentioned, leaving the contents within
the visible range, even if hidden, results in a scrolling problem if there
are enough hidden rows. So this isn't the desired solution.

Best regards,
Greg