Macro (Relação SSP/Comércio)

' Deploys monthly list
' @author Roger Lima (rplima01)
' @date oct/2015
' @update 20/jul/2016

' Verifies if the day is a holyday
Function is_holyday(ByVal holydays_fixed As Variant, ByVal holydays_carnival As Variant, ByVal current_date As String) As Boolean
        holyday_found = False

        ' Search in the list of fixed holydays
        For Each holyday In holydays_fixed
                If DateValue(holyday) = DateValue(current_date) Then
                        holyday_found = True
                        Exit For
                End If
        Next holyday

        ' Search in the carnival holyday list
        For Each holyday In holydays_carnival
                end_holyday = DateValue(holyday) + 1
                holyday = DateValue(holyday) - 4

                Do While DateValue(holyday) <> end_holyday + 1
                        If DateValue(holyday) = DateValue(current_date) Then
                                holyday_found = True
                                Exit For
                        End If

                        holyday = DateValue(holyday) + 1
                Loop
        Next holyday

        is_holyday = holyday_found
End Function

Sub gerarRelação()

' Holydays list
' Unfixed holydays just settled until 2026
holydays = Array("01/01", "21/04", "01/05", "24/06", "02/07", "07/09", "12/10", "02/11", "15/11", "08/12", "24/12", "25/12", "31/12", "14/04/2017", "30/03/2018", "19/04/2019", "10/04/2020", "02/04/2021", "15/04/2022", "07/04/2023", "29/03/2024", "18/04/2025", "03/04/2026")
holydays_carnival = Array("28/02/2017", "13/02/2018", "05/03/2019", "25/02/2020", "16/02/2021", "01/03/2022", "21/02/2023", "13/02/2024", "04/03/2025", "17/02/2026")

' Date setup
current_month = Month(DateValue("01 " & Split(ThisWorkbook.Name, ".")(0)))
current_year = StrReverse(Split(StrReverse(ThisWorkbook.Path), "\")(0))
sufix_date = "/" & current_month & "/" & current_year

' Initialize day
day_index = 1

' Gets number of valid days in the month
Do While True
        current_date = day_index & sufix_date

        If Not IsDate(current_date) Then Exit Do

        ' Skips saturday, sunday and holydays
        If Weekday(current_date) <> 1 And Weekday(current_date) <> 7 Then
                If Not is_holyday(holydays, holydays_carnival, current_date) Then valid_days = valid_days + 1
        End If

        day_index = day_index + 1
Loop

' Adds worksheets missing
Do While Worksheets.Count - 1 < valid_days
        Worksheets(1).Copy Before:=Worksheets(Worksheets.Count)
Loop

' Removes worksheets excess
Application.DisplayAlerts = False
Do While Worksheets.Count - 1 > valid_days
        Worksheets(1).Delete
Loop
Application.DisplayAlerts = True

day_index = 1

For Each ws In ThisWorkbook.Worksheets
        ws.Activate

        If ws.Name <> "Estatística" Then
                current_date = day_index & sufix_date

                ' Skips saturday, sunday and holydays
                Do While Weekday(current_date) = 1 Or Weekday(current_date) = 7 Or is_holyday(holydays, holydays_carnival, current_date)
                        day_index = day_index + 1
                        current_date = day_index & sufix_date
                Loop

                For i = 8 To 308
                        For j = 1 To IIf(i >= 8 And i <= 14, 8, 5)
                                If i = 8 And j < 7 Then j = 7
                                If j = 6 Then j = j + 1

                                ' Sets borders, alignments, font style and erases or fills cells
                                With Cells(i, j)
                                        .Borders.LineStyle = xlContinuous
                                        .VerticalAlignment = xlCenter
                                        .Font.Name = "Calibri"
                                        .Font.Size = 11
                                        .Font.Italic = False
                                        .Font.Underline = False
                                        .Font.Bold = False
                                        .Font.Color = RGB(0, 0, 0)

                                        If j = 1 Then
                                                .Value = i - 8
                                                .Font.Bold = True
                                        Else
                                                .Value = ""
                                        End If

                                        If j <> 2 Then
                                                .HorizontalAlignment = xlCenter
                                        End If

                                        If j = 5 Then
                                                .Font.Bold = True
                                        End If

                                        If i = 8 And j >= 7 Then
                                                .Font.Bold = True
                                                .Font.Name = "Arial"
                                        End If
                                End With
                        Next j
                Next i

                ' Columns width
                Columns("A").ColumnWidth = 3.5
                Columns("B").ColumnWidth = 50
                Columns("C").ColumnWidth = 20
                Columns("D").ColumnWidth = 8.5
                Columns("E").ColumnWidth = 8.5
                Columns("G").ColumnWidth = 12
                Columns("H").ColumnWidth = 8

                ' Daily statistic
                Range("G8").Value = "Estatística diária"
                Range("G8:H8").Merge
                Range("G9").Value = "1ª via"
                Range("G10").Value = "2ª via"
                Range("G11").Value = "3ª ou mais"
                Range("G12").Value = "MEC"
                Range("G13").Value = "RET. JUD"
                Range("G14").Value = "Total"
                Range("H9").Formula = "=COUNTIF(D9:D308,""1"")"
                Range("H10").Formula = "=COUNTIF(D9:D308,""2"")"
                Range("H11").Formula = "=COUNTIF(D9:D308,""3"")"
                Range("H12").Formula = "=COUNTIF(D9:D308,""MEC"")"
                Range("H13").Formula = "=COUNTIF(D9:D308,""RET.JUD"")+COUNTIF(D9:D308,""RET JUD"")+COUNTIF(D9:D308,""RET"")+COUNTIF(D9:D308,""RJ"")"
                Range("H14").Formula = "=SUM(H9:H13)"

                ' Change date and worksheet name
                ws.Name = day_index & " " & UCase(MonthName(current_month, True))
                Range("C5").Value = current_month & "/" & Split(ws.Name)(0) & "/" & current_year

                ' Deletes all below A308~E308 range
                Range("A309:E400").Delete

                day_index = day_index + 1
        End If
Next

Call gerarEstatística
End Sub