More efficient code?!

[justinjam]

Hello All,

I am novice VBA user and would appreciate a better or maybe more efficient way to evaluate range and it's property. Any advise with code herein is helpfull. Routine here loop only through 160 rows for my worksheet but is still very slow!!!

Sub Routine()
Dim r As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
r = 6
Do Until Cells(r, 3) = ""
    If Rows(r).EntireRow.Hidden = False Then
        If CountCM(Range("$A$" & r, "$DA$" & r)) = 0 Then
            Rows(r).EntireRow.Hidden = True
        End If
    End If
r = r + 1
Loop
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
 
 
Function CountCM(ByVal rng As Range)
    CountCM = 0
    For Each cell In rng
        If cell.Borders(xlDiagonalUp).LineStyle <> xlLineStyleNone Then
          CountCM = CountCM + 1
        End If
    Next
End Function

 

[ISY]

Hello

I used these commands you need to add:

Application.EnableEvents = False

at the end of the cycle resumes with the command

Application.EnableEvents = True

Then you absolutely must limit the search area are using the entire sheet

Excel 2003

 

[justinjam]

Thanks for a quick response. I tried the loop with disabled events, but still slow and same long time to complete.

Maybe there is a way to evaluate if a property setting is true within range as array. Maybe a way to handle multiple range and properties - it's more or less a conditional hide/show VBA feature am trying to accomplish.

Regards,
Justin

 

[alan.m]

Hello

you absolutely must limit the search area are using the entire sheet

Excel 2003

Hi Justinjam,
It's as ISY says,
your function CountCM is your problem as it is evaluating the entire worksheet each time it's called.
I think a function expects a value t be passed to it from the calling sub, so CountCM expects to be told what "rng" is.
When I run your code, rng has the value of Nothing.

It may be simpler to incorperate the logic from the function inside Sub Routine() ?

try

Sub Routine_original()
Dim r As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
r = 6
Do Until Cells(r, 3) = ""
    If Rows(r).EntireRow.Hidden = False Then
        If Cells(r, 3).Borders(xlDiagonalUp).LineStyle <> xlLineStyleNone Then
            Rows(r).EntireRow.Hidden = True
        End If
    End If
r = r + 1
Loop
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

HTH