Not counting up

[Stefan Braem]

Hi

I'm working on a code to make a copy of my template for every day of the year. All goes well, apart from my counter not counting up to number the folders which are created for every month. This is my code:

Function Create_Multiple_Workbooks()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = False
    
    Dim fec1 As Date, fec2 As Date
    Dim l1 As Workbook, h1 As Worksheet
    Dim ruta As String
    Dim Counter As Long
    Counter = 1
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Logboek")      'name of template sheet
    
    ruta = l1.Path & "\" & CStr(Counter)
    fec1 = DateSerial(Year(Date), 1, 1)
    fec2 = DateSerial(Year(Date), 12, 31)
    For i = fec1 To fec2
        Application.StatusBar = "Creating file : " & i
        mes = Format(i, " mmmm")
        If Dir(ruta & mes & "\") = "" Then
            Counter = Counter + 1
            MkDir (ruta & mes)
        End If
        ruta2 = ruta & mes & "\"
        arch = Format(i, "dd-mm-yyyy")
        h1.Copy
        Set l2 = ActiveWorkbook
        l2.SaveAs Filename:=ruta2 & arch & ".xlsm", _
            FileFormat:=52
        l2.Close False
    Next
    Application.StatusBar = False
End Function

The output now is "1 januari", "1 februari", ... instead of "1 januari", "2 februari", etc. Could someone help me on this?

Thanks in advance!

 

[GWteB]

Your variable ruta is assigned outside the For Next loop. Within this loop ruta is never updated, so the naming of the folders to create isn't as intended.
In the amended code snippet the counter variable is omitted, mes1 is used to assign the desired prefix. It's not as efficient as it could be, nevertheless it probably does what you're after.

    For i = fec1 To fec2
        
        Application.StatusBar = "Creating file : " & i
        
        mes1 = Format(i, "mm")
        mes2 = Format(i, " mmmm")
        ruta = l1.Path & "\" & mes1 & mes2
        
        If Len(Dir(ruta, vbDirectory)) = 0 Then
            MkDir (ruta)
        End If
        
        arch = Format(i, "dd-mm-yyyy")
        h1.Copy
        Set l2 = ActiveWorkbook
        l2.SaveAs Filename:=ruta & "\" & arch & ".xlsm", FileFormat:=52
        l2.Close False
    
    Next

 

[Stefan Braem]

Your variable ruta is assigned outside the For Next loop. Within this loop ruta is never updated, so the naming of the folders to create isn't as intended.
In the amended code snippet the counter variable is omitted, mes1 is used to assign the desired prefix. It's not as efficient as it could be, nevertheless it probably does what you're after.

    For i = fec1 To fec2
       
        Application.StatusBar = "Creating file : " & i
       
        mes1 = Format(i, "mm")
        mes2 = Format(i, " mmmm")
        ruta = l1.Path & "\" & mes1 & mes2
       
        If Len(Dir(ruta, vbDirectory)) = 0 Then
            MkDir (ruta)
        End If
       
        arch = Format(i, "dd-mm-yyyy")
        h1.Copy
        Set l2 = ActiveWorkbook
        l2.SaveAs Filename:=ruta & "\" & arch & ".xlsm", FileFormat:=52
        l2.Close False
   
    Next

That worked, thanks! ?

 

[GWteB]

You are welcome and thanks for letting me know.