Misschien is dit nog beter.
Private Sub Workbook_Open()
Worksheets("Budget").Activate
herhalend = Sheets("Herhalend").Cells(1, 1).CurrentRegion 'alle 'herhalingen' inlezen
For i = 1 To UBound(herhalend) 'aflopen van boven naar onder
' is het een weerkerende dag of een datum in de toekomst
If herhalend(i, 1) > 0 And herhalend(i, 1) < 32 Then dag = DateSerial(Year(Date), Month(Date), herhalend(i, 1)) Else dag = herhalend(i, 1)
If herhalend(i, 1) < 4 And Day(Date) > 24 Then
dag = WorksheetFunction.EDate(dag, 1)
End If
If herhalend(i, 1) > 24 And Day(Date) < 4 Then
dag = WorksheetFunction.EDate(dag, -1)
End If
If dag > Date - 4 And dag < Date + 4 Then 'is herhalende dag 4 dagen minder of meer dan vandaag
categorie = herhalend(i, 2) 'categorie wordt opgehaald uit het blad "herhalend"
begunstigde = herhalend(i, 3) 'tegenpartij wordt opgehaald uit het blad "herhalend"
bedrag = herhalend(i, 4) 'bedrag wordt opgehaald uit het blad "herhalend"
soort = herhalend(i, 5) 'als soort een T is dan een betaling in de toekomst , een M dan maandelijkse betaling
'tekst van msgbox bepalen naargelang het een (M)aandelijkse of een betaling in de (T)oekomst is
If soort = "T" Then tekst1 = "Volgende 'betaling in de Toekomst' :" + (Chr(13)) + (Chr(13)): tekst2 = "Betaling in de Toekomst" + (Chr(13))
If soort = "M" Then tekst1 = "Deze 'maandelijkse betaling' :" + (Chr(13)) + (Chr(13)): tekst2 = "Maandelijkse Verrichting" + (Chr(13))
tezoeken = begunstigde
rij = Application.Match(tezoeken, Columns(2), 0) 'de kolom 2 doorzoeken naar een overeenkomst met cel "Rubriek"
kolom = Month(Date) + 2 'stel nu de kolom in om het bedrag in te vullen
If IsNumeric(rij) And IsNumeric(kolom) Then
If Cells(rij, kolom).Value <> "" Then GoTo Volgende 'is de verhandeling reeds gebeurd ? zoja volgende item
If MsgBox(tekst1 + " '" & categorie & " / " & begunstigde & "' invullen ?", vbYesNo + vbQuestion, tekst2) = vbNo Then GoTo Volgende 'antwoord ja = invullen , antwoord nee = de rij verder afwerken
Cells(rij, kolom).Value = bedrag 'verrichting_uitvoeren
Else
MsgBox "Oeps, de begunstigde " & tezoeken & " staat niet op het blad BUDGET" & vbCrLf & _
"Misschien een tikfoutje? Controleer de benaming." & vbCrLf & _
"Of ben je deze vergeten in te vullen op blad BUDGET? "
End If
End If
Rem niets invullen , de gegevens wissen die ingevuld waren
Volgende:
' Cells(3, 4).Select
Next i
End Sub