I have a sub that hides recorders that are younger than a specified
date as long as they aren't part of a group that has a record in it
which is older than that date.
The sub works except the time that it takes increases exponentially to
the number of records that need to be hidden.
When that number gets upwards of 2000 out of 6000 it can take 10's of
mins, which kills its usefulness.
The problem seems to be in changing the hidden property to true. For
some reason this process takes an excessive amount of time.
I was thinking I may be able to collect the rows into an object or
range and hide them all at once but I haven't been able to come up
with a way to do that cleanly. (ie: select a row, find the next row
and it to the selection …)
Can anyone help me find a way to speed this up?
I'll be your best friend :)

Shaun Kohanowski
general macro nerd @ SEI

Sub Age_Select()

'This is error handling
On Error Resume Next
If Not Cells(1, ZONE).Value = "Zone" Then
End
End If
On Error GoTo 0

'This is preprocess setup
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim age As Integer
Cells.EntireRow.Hidden = False

'This converts the string contents of the combo box to a day value
Set neoControl = Application.CommandBars("Open
Cases").FindControl(msoControlComboBox)
Select Case neoControl.List(neoControl.ListIndex)
Case "Day"
age = 1
Case "3 Days"
age = 3
Case "Week"
age = 7
Case "2 Weeks"
age = 14
Case "Month"
age = 30
End Select

'This locates and hides the records that are younger than the day
value
'and are not of the same group ID
i = 2
j = 2
Do Until Cells(i, LAST) = ""
If DateDiff("d", Cells(i, LAST), Now()) <= age Then
If Not Cells(i, NATL) = Cells(j, NATL) Then
Rows(i).Hidden = True ' <--- This seems to be the
problem
End If
j = i
End If
i = i + 1
Loop

'This is post processing cleanup
Group

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Hi Shaun,

the following type of construct should do want you want:

Dim Rng As Range

If Not Rng Is Nothing Then
Set Rng = Union(Rng, Rows(i))
Else
Set Rng = Rows(i)
End If
Next
Rng.EntireRow.Hidden = True


In terms of speed. it might be worth adding the line:

ActiveSheet.DisplayPageBreaks = False


---
Regards,
Norman



"ski" wrote in message
om...
I have a sub that hides recorders that are younger than a specified
date as long as they aren't part of a group that has a record in it
which is older than that date.
The sub works except the time that it takes increases exponentially to
the number of records that need to be hidden.
When that number gets upwards of 2000 out of 6000 it can take 10's of
mins, which kills its usefulness.
The problem seems to be in changing the hidden property to true. For
some reason this process takes an excessive amount of time.
I was thinking I may be able to collect the rows into an object or
range and hide them all at once but I haven't been able to come up
with a way to do that cleanly. (ie: select a row, find the next row
and it to the selection .)
Can anyone help me find a way to speed this up?
I'll be your best friend :)

Shaun Kohanowski
general macro nerd @ SEI

Sub Age_Select()

'This is error handling
On Error Resume Next
If Not Cells(1, ZONE).Value = "Zone" Then
End
End If
On Error GoTo 0

'This is preprocess setup
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim age As Integer
Cells.EntireRow.Hidden = False

'This converts the string contents of the combo box to a day value
Set neoControl = Application.CommandBars("Open
Cases").FindControl(msoControlComboBox)
Select Case neoControl.List(neoControl.ListIndex)
Case "Day"
age = 1
Case "3 Days"
age = 3
Case "Week"
age = 7
Case "2 Weeks"
age = 14
Case "Month"
age = 30
End Select

'This locates and hides the records that are younger than the day
value
'and are not of the same group ID
i = 2
j = 2
Do Until Cells(i, LAST) = ""
If DateDiff("d", Cells(i, LAST), Now()) <= age Then
If Not Cells(i, NATL) = Cells(j, NATL) Then
Rows(i).Hidden = True ' <--- This seems to be the
problem
End If
j = i
End If
i = i + 1
Loop

'This is post processing cleanup
Group

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Norman,
You are a super magical man :)
That cut the run time to less than half a min
Wish I knew why
This is what I ended up with
thanks again

Shaun


Dim hideList As Range
Set hideList = Rows(Rows.Count)

i = 2
j = 2
Do Until Cells(i, LAST) = ""
If DateDiff("d", Cells(i, LAST), Now()) <= age Then
If Not Cells(i, NATL) = Cells(j, NATL) Then
Set hideList = Union(hideList, Rows(i))

End If
Else
j = i
End If
i = i + 1
Loop
hideList.EntireRow.Hidden = True

If the change was to hide all rows at the end, instead of one at a time,
that's the reason: operations like that are very time-consuming, and it takes
very little more time to carry it out on several rows than on one.

On 6 Oct 2004 15:14:43 -0700, (ski) wrote:

Norman,
You are a super magical man :)
That cut the run time to less than half a min
Wish I knew why
This is what I ended up with
thanks again

Shaun


Dim hideList As Range
Set hideList = Rows(Rows.Count)

i = 2
j = 2
Do Until Cells(i, LAST) = ""
If DateDiff("d", Cells(i, LAST), Now()) <= age Then
If Not Cells(i, NATL) = Cells(j, NATL) Then
Set hideList = Union(hideList, Rows(i))

End If
Else
j = i
End If
i = i + 1
Loop
hideList.EntireRow.Hidden = True