speed up macro

Pindacko · April 21st, 2006, 07:28 PM

Could anyone help a newbie I would like to speed up this macro.
Thanks
Cool

Sub auto_Open()
    Application.EnableEvents = False
ActiveSheet.Unprotect Password:="TEST"
Optimization = True
            EventsEnabled = False

Const sPWORD As String = "TEST"
With Worksheets(1)
    Application.ScreenUpdating = False
    Selection.AutoFilter Field:=1
    Selection.AutoFilter Field:=2
    Selection.AutoFilter Field:=3
    Selection.AutoFilter Field:=8
    Selection.AutoFilter Field:=9
    Selection.AutoFilter Field:=10
    Selection.AutoFilter Field:=11
    Selection.AutoFilter Field:=12
    Selection.AutoFilter Field:=13
    Selection.AutoFilter Field:=14
      If Not .AutoFilterMode Then
    .Range("A5:N3528").AutoFilter
  End If
  .EnableAutoFilter = True
     BeginRow = 8
    EndRow = 3700
    ChkCol = 3

    For RowCnt = BeginRow To EndRow
        If Cells(RowCnt, ChkCol).Value < 10 Then
           Cells(RowCnt, ChkCol).EntireRow.Hidden = True
        End If
    Next RowCnt
     Application.ScreenUpdating = True

          .Protect Password:=sPWORD, _
Contents:=True, _
UserInterfaceOnly:=True
             EventsEnabled = True
             Optimization = False

End With

    Application.EnableEvents = True
End Sub

jrogers · April 27th, 2006, 01:41 PM

A couple of things, you have hard coded your end range to 3700, is this a fixed length, or will it change over time (if more records are in the sheet), ignoring this I found a way to speed up the macro in the following way, not very need, but it does speed up quite a bit

Code:

Sub auto_Open()
    Application.EnableEvents = False
ActiveSheet.Unprotect Password:="TEST"
Optimization = True
            EventsEnabled = False

Const sPWORD As String = "TEST"
With Worksheets(1)
    Application.ScreenUpdating = False
    If Not .AutoFilterMode Then
        .Range("A5:N3528").AutoFilter
    End If
   .EnableAutoFilter = True
     BeginRow = 8
    EndRow = 3700
    ChkCol = 3
    blnfirst = True
    blnmorethan24 = False
    intcount = 1
 
    For rowcnt = BeginRow To EndRow
        If Cells(rowcnt, ChkCol).Value < 10 Then
            Select Case blnfirst
                Case True
                    strrange = strrange & rowcnt & ":" & rowcnt
                    blnfirst = False
                    blnmorethan24 = False
                Case False
                    intcount = intcount + 1
                    strrange = strrange & "," & rowcnt & ":" & rowcnt
                    If intcount = 25 Then
                        Range(strrange).EntireRow.Hidden = True
                        strrange = ""
                        intcount = 1
                        blnfirst = True
                        blnmorethan24 = True
                    End If
           End Select

        End If
    Next rowcnt

    If blnmorethan24 = False Then
        Range(strrange).EntireRow.Hidden = True
    End If
     Application.ScreenUpdating = True

    .Protect Password:=sPWORD, _
    Contents:=True, _
    UserInterfaceOnly:=True
    EventsEnabled = True
    Optimization = False

End With


    Application.EnableEvents = True
End Sub