Een stukje Vba is ook niet verkeerd in dit geval Marcel.
Dank Harry, ik ben nog steeds aan het leren. :thumb:
Maarre..helemaal fullproof is die code niet: als je meerdere cellen tegelijk wijzigt, dan levert het een foutmelding op.
Ook voor Nynke natuurlijk:
Ik ben er nog even mee aan het stoeien geweest om het helemaal waterdicht te maken.
Hierbij heb ik ook meegenomen dat er geen gaten mogen vallen in kolom A van blad 'Sleutelbeheer'
Daartoe heb ik ook de formules van de gedefinieerde namen aangepast:
Sleutels: =sleutelbeheer!$A$2:INDEX(sleutelbeheer!$A:$A;MAX(AANTALARG(sleutelbeheer!$A:$A);AANTALARG(sleutelbeheer!$D:$D)))
Innames: =sleutelbeheer!$E$2:INDEX(sleutelbeheer!$E:$E;MAX(AANTALARG(sleutelbeheer!$A:$A);AANTALARG(sleutelbeheer!$D:$D)))
De macro is nu geworden:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim cl As Range
On Error Resume Next
Intersect(Range("Sleutels"), Range("Sleutels").SpecialCells(xlCellTypeBlanks)).Value = "Onbekend"
On Error GoTo 0
Set rng = Intersect(Target, Union(Range("Sleutels"), Range("Innames")))
If rng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each cl In rng
If cl.Row > 2 Then cl.Offset(, IIf(cl.Column = 1, 3, 1)) = IIf(cl.Value <> "", Now, "")
Next cl
Application.EnableEvents = True
End Sub
Het lijkt mij best practice om EnableEvents uit te schakelen in code van een Change Event; tegelijkertijd heb ik een uitzondering gemaakt daar waar "Onbekend" ingevuld wordt, zodat die ook een datum krijgen.
Verder heb ik nog een stukje code met bijbehorende knop gemaakt om geselecteerde regels weer leeg te maken: als je de onderste regels leeg maakt, dan blijven ze ook echt leeg. Als je tussenliggende regels leeg maakt, dan krijgen die een "Onbekend" invulling.
Edit: de regels met "Onbekend" kunnen eventueel hergebruikt worden voor nieuwe sleuteluitgiften.
Code:
Option Explicit
Sub MaakRegelsLeeg()
Application.EnableEvents = False
Selection.EntireRow.ClearContents
Application.EnableEvents = True
On Error Resume Next
Intersect(Range("Sleutels"), Range("Sleutels").SpecialCells(xlCellTypeBlanks)).Value = "Onbekend"
On Error GoTo 0
End Sub
Last but not least heb ik nog een controle toegevoegd dat er niet méér sleutels worden uitgegeven dan er beschikbaar zijn:
- de formule in Sleutelplan K12 en gekopieerd naar beneden is nu: =J12-AANTALLEN.ALS(Sleutels;A12;Innames;"=")
- de bijbehorende formule voor voorwaardelijke opmaak: =EN($K12=0;$J12<>"")
- eventuele foutmelding in Sleutelbeheer!H1 en voorwaardelijke opmaak om dan het hele blok A1:L2 rood te kleuren
- op tab Beeld heb ik deelvensters geblokkeerd zodat regels 1 en 2 altijd zichtbaar zijn.
