Excel traag ! Door Worksheet_Change (ByVal Target as Range) ???

[McMacro]

Beste Excellers,

Sinds vandaag 'loopt' m'n excelbestand erg traag. Ik heb een lijst die gevuld wordt van kolom A:AN. In kolom AN, vanaf rij 4 en verder, staat de status van ieder "dossier" [*lees: rij]

Iedere cel in kolom AN vanaf rij 4 is gevalideerd. Men heeft de keuze uit 'In Behandeling', 'Hold' en 'Afgehandeld'. Ze krijgen kleur passend bij hun status (zie code hieronder).

De Lijst bestaat uit een titelblok (Rij 1 t/m Rij 3) En vanaf Rij 4 een ingevulde lijst.

Een groot deel van een Rij uit de lijst tussen kolom A en AN hebben validatielijstjes. Iedere keer als ik een cel in een rij invul door een keuze te maken uit zo'n lijstje, duurt het veel te lang voordat ik een volgende cel kan invullen.

Komt dit misschien door onderstaande code? Zo ja, kan dit sneller? En kan er niet alleen gecontroleerd worden of er iets gewijzigd is in kolom AN?, zodat de code niet onnodig de hele lijst op iedere cel controleerd of er iets gewijzigd is?

Private Sub Worksheet_Change(ByVal Target As Range)

For Each x In Range("AN4:AN" & Range("AN1000").End(xlUp).Row)

If x = "In Behandeling" Then
    Application.EnableEvents = False
    ActiveSheet.Unprotect password:="xxxx"
        Range("A" & x.Row, "AD" & x.Row).Interior.ColorIndex = 37       'Blauw
        Range("AE" & x.Row, "AJ" & x.Row).Interior.ColorIndex = 15      'Grijs
        Range("AK" & x.Row, "AN" & x.Row).Interior.ColorIndex = 37      'Blauw
    ActiveSheet.Protect password:="xxxx"
    Application.EnableEvents = True
    
ElseIf x = "HOLD" Then
    Application.EnableEvents = False
    ActiveSheet.Unprotect password:="xxxx"
        Range("A" & x.Row, "AD" & x.Row).Interior.ColorIndex = 3        'Rood
        Range("AE" & x.Row, "AJ" & x.Row).Interior.ColorIndex = 15      'Grijs
        Range("AK" & x.Row, "AN" & x.Row).Interior.ColorIndex = 3       'Rood
    ActiveSheet.Protect password:="xxxx"
    Application.EnableEvents = True
    
ElseIf x = "Afgehandeld" Then
    Application.EnableEvents = False
    ActiveSheet.Unprotect password:="xxxx"
        Range("A" & x.Row, "AD" & x.Row).Interior.ColorIndex = 43       'Groen
        Range("AE" & x.Row, "AJ" & x.Row).Interior.ColorIndex = 15      'Grijs
        Range("AK" & x.Row, "AN" & x.Row).Interior.ColorIndex = 43      'Groen
    ActiveSheet.Protect password:="xxxx"
    Application.EnableEvents = True
    
ElseIf x = "" Then
    Application.EnableEvents = False
    ActiveSheet.Unprotect password:="xxxx"
        Range("A" & x.Row, "AN" & x.Row).Interior.ColorIndex = 15       'Grijs
    ActiveSheet.Protect password:="xxxx"
    Application.EnableEvents = True

End If
Application.EnableEvents = True
    Next
End Sub

Veel succes met de uitdaging?!
Zijn er nog onduidelijkheden? Dan hoor ik dat graag!

Met vriendelijke groet,

McMacro

 

[Roncancio]

Het zou al veel schelen als de macro niet steeds het hele bereik controleert zodra je 1 cel verandert.
Door je te richten op die ene cel en de daarbij behorende rij, win je veel tijd.
Onderstaande code is een voorbeeld n.a.v. je code maar er zijn natuurlijk meerdere manieren.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCol As Integer
    If Target.Column = 40 Then
        ActiveSheet.Unprotect Password:="xxxx"
        Select Case Target.Value
            Case "In Behandeling"
                iCol = 37 'Blauw
            Case "Hold"
                iCol = 3  'Rood
            Case "Afgehandeld"
                iCol = 43 'Groen
        End Select
        Application.Union(Range("A" & Target.Row, "AD" & Target.Row), Range("AK" & Target.Row, "AN" & Target.Row)).Interior.ColorIndex = iCol
        Range("AE" & Target.Row, "AJ" & Target.Row).Interior.ColorIndex = 15
        ActiveSheet.Protect Password:="xxxx", UserInterFaceonly:=True
    End If
End Sub

Met vriendelijke groet,


Roncancio

 

[McMacro]

Thanks a lot!!!

Bedankt Roncancio !

Ik kan er helaas pas donderdag mee aan de slag. Maar 't ziet er logisch uit.

Dan zal ik de vraag zo snel als mogelijk afhandelen.

Met vriendelijke groet,

McMacro

 

[McMacro]

Het werkt !
Ik heb alleen nog het paarse gedeelte toegevoegd, zodat het verhaal compleet is.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCol As Integer
    If Target.Column = 40 Then
        ActiveSheet.Unprotect Password:="xxxx"
        Select Case Target.Value
            Case "In Behandeling"
                iCol = 37 'Blauw
            Case "Hold"
                iCol = 3  'Rood
            Case "Afgehandeld"
                iCol = 43 'Groen
[COLOR="darkslateblue"]            [B]Case ""
                iCol = 15 'Grijs[/B][/COLOR]        
            End Select
        Application.Union(Range("A" & Target.Row, "AD" & Target.Row), Range("AK" & Target.Row, "AN" & Target.Row)).Interior.ColorIndex = iCol
        Range("AE" & Target.Row, "AJ" & Target.Row).Interior.ColorIndex = 15
        ActiveSheet.Protect Password:="xxxx", UserInterFaceonly:=True
    End If
End Sub

Nogmaals bedankt voor de snelle reactie!

Met vriendelijke groet,

McMacro