the following VBA file keeps telling me that i have a Do without a loop and when I insert a loop it tells me that it has a loop without a do. I am quite lost at where the problem is. (if you have some tweaks for the code please feel welcome to suggest, because I am quite new at this and tend to use codes from which I know that they work)
this is the VBA
and I'll attach the whole workbookSub regouin() Dim yr As Integer, WS As Worksheet, SDate As Date, wks As Integer, i As Integer, leap As String On Error Resume Next yr = InputBox(Prompt:="Please enter year", Default:=Year(Date)) On Error GoTo 0 If yr = 0 Then Exit Sub If Not IsDate(DateSerial(yr, 1, 1)) Then Exit Sub Application.ScreenUpdating = False SDate = DateSerial(yr, 1, 1) Worksheets("kalender").Range("b1").FormulaR1C1 = yr leap = Worksheets("kalender").Range("l6") On leap = "ja" GoSub schrikkel If Weekday(SDate) = 5 Then wks = 53 Else wks = 52 If Weekday(SDate) < 5 Then Do Until Weekday(SDate, vbMonday) = 1 SDate = SDate - 1 If Weekday(SDate) = vbMonday Then GoTo invul Else: Do Until Weekday(SDate, vbMonday) = 1 SDate = SDate + 1 invul: Do Loop Range("A1:G1") = Array("Week nummer", "Start datum", "Eind datum", "Linker Voorwas", "Rechter Voorwas", "Hoofdwas 1", "Hoofdwas 2") Range("A2:C2") = Array(1, SDate + 1, SDate + 7) For i = 2 To wks Range("A1:C1").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6) Next i Columns.AutoFit Application.ScreenUpdating = True Exit Do End Sub Sub schrikkel() If Weekday(SDate) = 5 Or Weekday(SDate) = 4 Then wks = 53 Else wks = 52 If Weekday(SDate) < 5 Then Do Until Weekday(SDate, vbMonday) SDate = SDate - 1 If Weekday(SDate) = vbMonday Then GoTo invuls Else: Do Until Weekday(SDate, vbMonday) SDate = SDate + 1 invuls: Loop Range("A1:G1") = Array("Week number", "Starting date", "Ending date", "#1", "#2", "#3", "#4") Range("A2:C2") = Array(1, SDate, SDate + 6) For i = 2 To wks Range("A1:C1").Offset(i, 0) = Array(i, SDate + (7 * (i - 1)), SDate + (7 * (i - 1)) + 6) Next i Columns.AutoFit Application.ScreenUpdating = True End Sub
TIA
Frank





Reply With Quote