Macro voor datum

[autoweek]

Beste helper,

Zie de bijgevoegde bijlage.
Bestaat er een macro die de datum's in kolom E met vijf jaar opteld wanneer deze kleiner dan de datum van vandaag is in cel C1.
Bekijk bijlage aanvraag.xlsx

 

[Haije]

Ralf,

wat is er mis met de formule die je nu gebruikt?
M.a.w. waarom zoek je een macro?

 

[autoweek]

De formule die ik in kolom F heb staan doet inderdaad waar ik naar op zoek ben. Alleen wanneer die nieuwe datum is bereikt moet hij weer vijf jaar optellen en moet ik dus weer een kolom aanmaken.
Wat ik graag zou willen is dat ik kolom F niet nodig heb, maar dat in kolom E de nieuwe datum komt te staan.

 

[Haije]

Ralf,

oké, volstaat het dan dat er elke keer als het bestand geopend wordt een controle/aanpassing plaatsvindt?

 

[autoweek]

Dat zou perfect volstaan!

 

[Haije]

Ralf,

als het idd bij het openen van het bestand gecheckt moet worden, plaats dan dit in ThisWorkbook:

Private Sub Workbook_Open()
    Sheets(1).Select
Dim nieuw As Date
    x = 1
Do While Range("E1").Offset(x) <> ""
    vandaag = Date
    waarde = Range("E1").Offset(x).Value
    nieuw = (Right(waarde, 4) + 5) & "-" & (Mid(waarde, 4, 2)) & "-" & (Left(waarde, 2))
        If waarde < vandaag Then Range("E1").Offset(x) = nieuw
    x = x + 1
Loop
End Sub

 

[autoweek]

nieuw = (Right(waarde, 4) + 5) & "-" & (Mid(waarde, 4, 2)) & "-" & (Left(waarde, 2))
Bij dit deel van de macro krijg ik een foutmelding als ik het bestand open

 

[autoweek]

Dat heb inmiddels verholpen, alleen doet de macro niks, bij openen van het bestand gebeurt er niks

 

[ReneDirks]

nieuw = (Right(waarde, 4) + 5) & "-" & (Mid(waarde, 4, 2)) & "-" & (Left(waarde, 2))

Da's een heel ingewikkelde manier om 5 jaar ergens bij op te tellen die dan ook meteen fout gaat als het datum formaat even anders is. Beter is het om Excel het rekenwerk te laten doen:

nieuw = DateAdd("yyyy", 5, waarde)

De code van Haije zou dan zoiets worden (ik heb de code alleen wat aangepast, ik moet toegeven dat ik niet gekeken heb of de code verder klopt):

Private Sub Workbook_Open()
    Sheets(1).Select
Dim nieuw As Date
Dim x as Long
Dim vandaag as Date
    x = 1

    Do While Range("E1").Offset(x) <> ""
        vandaag = Date
        waarde = Range("E1").Offset(x).Value
        If Not IsDate(waarde) Then
            'even controleren of dit een geldige datum is..
            MsgBox ("Geen geldige datum in kolom E voor rij " & x)
        Else
            nieuw = DateAdd("yyyy", 5, waarde)
            If waarde < vandaag Then Range("E1").Offset(x) = nieuw
        End If
        x = x + 1
    Loop
End Sub

 

[autoweek]

Hij werkt!
Haije, Hartstikke bedankt voor je hulp! Jou oplossing heeft ReneDirks tot de uiteindelijke oplossing geholpen, ReneDirks ook jij bedankt daarvoor!

 

[Warme bakkertje]

Of

Private Sub Workbook_Open()
    With Sheets(1)
        sq = .Range("E2:E" & .Cells(Rows.Count, 5).End(xlUp).Row)
        For i = 1 To UBound(sq)
            If sq(i, 1) < Date Then sq(i, 1) = DateAdd("yyyy", 5, sq(i, 1))
        Next
        .Range("E2").Resize(UBound(sq)) = sq
    End With
End Sub