Macro is traag

[Jwitte]

Beste allen,

ik ben een bestand aan het maken met vele macro's erin. Mijn eerste vraag is: wordt een bestand traag door de vele macro's die in een bestand zitten, of alleen wanneer de maxro's worden uitgevoerd?

Daarnaast heb ik een aantal grote macro's geschreven die vermoedelijk veel compacter en sneller kunnen worden weergeggeven. Het utivoeren van deze macro's duren dan ook erg lang.

Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


Dim WB As Object
For Each WB In ActiveWorkbook.Worksheets
WB.Visible = xlSheetVisible
Next WB

For Each WB In ActiveWorkbook.Sheets
If WB.Name <> "Dump 15" Then
WB.Visible = xlSheetHidden
End If
Next

If ActiveSheet.AutoFilterMode Then

ActiveSheet.AutoFilterMode = False

End If
Sheets("Dump 15").Select
Range("A2").Select
Selection.AutoFilter
ActiveSheet.Range("$A$2:$L$2").AutoFilter Field:=9, Criteria1:= _
"Maken"
ActiveSheet.Range("$A$2:$L$2").AutoFilter Field:=12, Criteria1:="To do"
ActiveWorkbook.Worksheets("Dump 15").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Dump 15").AutoFilter.Sort.SortFields.Add2 Key:= _
Range("H:H"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Dump 15").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub

Deze code moet het volgende doen:
huidig tabblad verbergen
tabblad DUmp 15 openen
Als er nog een filter aanstond in tabblad Dump 15, moet deze eerst uit (toch?)
kolom 9 filteren op Maken
Kolom 12 filteren op To Do
Kolom H sorteren van hoog naar laag


Ik heb expres geen tabel er van gemaakt vanwege andere funcionaliteiten
Verder heb ik getracht om hem te versnellen door de code op eerste en laatste 4 regels.

Wie kan mij helpen om deze code mooier te laten uitvoeren?

Alvast bedankt!

Job

 

[edmoor]

Een bestand wordt niet trager wegens de hoeveelheid macro's.
Plaats in ieder geval een voorbeeld document.

 

[VenA]

2 keer dezelfde lus werkt niet echt versnellend. Waarom beginnen jouw gegevens niet in A1? Dan kan je cells(1).currentregion gebruiken. Maak svp gebruik van de code tags ipv de quotetags voor de leesbaarheid.

met 1 loopje

Sub VenA()
  For Each sh In Sheets
    sh.Visible = sh.Name = "Dump 15"
  Next
End Sub

En verder sluit ik mij aan bij de 2e zin in #2

 

[jkpieterse]

@VenA: Als werkblad Dump 15 hidden is bij start van de code en het is niet het eerste werkblad dan geeft jouw code mogelijk een foutmelding omdat er altijd tenminste 1 werkblad zichtbaar moet zijn. Dus voor de loop toevoegen:

Worksheets("Dump 15").Visible = xlSheetVisible

@JWitte: Declareer WB als het juiste type:

Dim WB As Worksheet

Wellicht is dit ietsiepietsie sneller:

Sub JouwMacro()
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    Dim Ws As Worksheet
    Worksheets("Dump 15").visble = xlSheetVisible
    For Each Ws In ActiveWorkbook.Worksheets
        Ws.Visible = (Ws.Name = "Dump 15")
    Next Ws
    With Worksheets("Dump 15")
        If .AutoFilterMode Then
            .AutoFilterMode = False
        End If
        .Range("A2").AutoFilter
        .Range("$A$2:$L$2").AutoFilter Field:=9, Criteria1:= _
                                       "Maken"
        .Range("$A$2:$L$2").AutoFilter Field:=12, Criteria1:="To do"
        With .AutoFilter.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("H:H"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortTextAsNumbers
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With
End Sub

 

[Jwitte]

Beste allen,

Met de gebundelde krachten lukt het me om de code uit te voeren, waarvoor dank!
Wat JKPieterse zegt klopt betreffende de worksheet. Met de toevoeging van Pieterse lukt het.
Hij werkt iets beter. Als ik alsnog tegen problemen aanlopen, zal ik een nieuwlsnog tegen problemen aanlopen, zal ik een nieuwe vraag starten EN een bestandje toevoegen!

Dank

Job