Opgelost Code aanpassen voor datum in 3 kolommen

[Lampie173]

In bijgevoegd voorbeeld staat de vraag uitgebreid uitgeschreven.

Het gaat om 3 kolommen waar een datum ingevuld wordt.

Dank voor het lezen.

Toon

 

[AHulpje]

Korter:

 

[HSV]

Korter is:

If Target = 0 Then

I.p.v.

If Cells(Target.Row, Target.Column) = 0 Then

Of beter:

If Target = "" Then

On Error Resume Next - On error Goto 0 lijkt me ook overbodig evenals Application.ScreenUpdating = True en de Application voor Intersect.
Dan kom ik uit op:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("D10:D19,D22:D29,D32:D41,I10:I13,I16:I19,I22:I29,I32:I41,N10:N13,N16:N17,N20")) Is Nothing Then
    Application.EnableEvents = False
            If Target = 0 Then
                Target.Offset(, 1).ClearContents
             Else
                Target.Offset(, 1) = Date
            End If
            Application.EnableEvents = True
    End If
End Sub

Waar ik overigens geen liefhebber van ben, maar wel kan.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("D10:D19,D22:D29,D32:D41,I10:I13,I16:I19,I22:I29,I32:I41,N10:N13,N16:N17,N20")) Is Nothing Then
   Application.EnableEvents = False
    If Target = 0 Then Target.Offset(, 1).ClearContents Else Target.Offset(, 1) = Date
   Application.EnableEvents = True
 End If
End Sub

En dan kan de Application.EnableEvents er ook nog beide wel uit, verneem je niets van.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("D10:D19,D22:D29,D32:D41,I10:I13,I16:I19,I22:I29,I32:I41,N10:N13,N16:N17,N20")) Is Nothing Then
    If Target = 0 Then Target.Offset(, 1).ClearContents Else Target.Offset(, 1) = Date
 End If
End Sub

Of:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("D10:D19,D22:D29,D32:D41,I10:I13,I16:I19,I22:I29,I32:I41,N10:N13,N16:N17,N20")) Is Nothing Then
  Target.Offset(, 1) = IIf(Target = "", "", Date)
 End If
End Sub

Teruggebracht naar maar een regel.

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("D10:D19,D22:D29,D32:D41,I10:I13,I16:I19,I22:I29,I32:I41,N10:N13,N16:N17,N20")) Is Nothing Then Target.Offset(, 1) = IIf(Target = "", "", Date)
End Sub

 

[AHulpje]

Nóg korter:

If Target.Offset(, 1).Interior.ColorIndex = 15 Then Target.Offset(, 1) = IIf(Target = "", "", Date)

 

[HSV]

Geen idee of die kleur er altijd staat natuurlijk.
Korter?

If Target.Offset(, 1).Interior.ColorIndex > 0 Then Target.Offset(, 1) = IIf(Target = "", "", Date)

 

[Lampie173]

AHulpje,

Dank voor je snelle reactie.

Dat scheelt een hoop regels zeg!

Ik wist heel stiekem dat de Ranges aan elkaar 'geplakt' konden worden.
Maar de rest.....
nogmaals dank.

 

[Lampie173]

Ik dacht dat SNB de ster van de oneliners was, maar jullie kunnen er ook wat van, hoor!
Ik ga ermee stoeien.

Nogmaals dank.

 

[Lampie173]

@HSV,
Jouw opmerking:

Waar ik overigens geen liefhebber van ben, maar wel kan.

Wat bedoel je hiermee?
Kan de code op een nog andere manier geschreven worden?
Of heeft dat betrekking op samenvoegen van de Ranges in 1 regel?

 

[HSV]

Nee, zoals de code die daar onder staat, de IF Then Else op 1 rij geschreven.
Het staat wel leuk en ook effectief, maar het wordt allemaal onoverzichtelijk doordat de 'Else' je niet opvalt.

 

[Lampie173]

Helder!

 

[CorVerm]

Wie heeft de kortste?