---

Option Explicit

Private Const REPORT_SHEET_DASH As String = "Dash"
Private Const REPORT_SHEET_SUMMARY As String = "Summary"
Private Const REPORT_SHEET_REPAIRS As String = "Repairs"
Private Const REPORT_SHEET_REASONS As String = "Reasons"
Private Const REPORT_SHEET_FILES As String = "Files"

' Type these 3 names manually in VBA editor after pasting:
Private Const SRC_SHEET_DES As String = "TYPE_MANUALLY_1"
Private Const SRC_SHEET_BOILERS As String = "TYPE_MANUALLY_2"
Private Const SRC_SHEET_REPAIRS As String = "TYPE_MANUALLY_3"

' Fixed structure based on your sample files
Private Const DES_COL_RUNNING As Long = 8      ' H
Private Const DES_COL_RESERVE As Long = 9      ' I
Private Const DES_COL_REPAIR As Long = 10      ' J
Private Const DES_COL_LOAD As Long = 11        ' K

' IMPORTANT:
' If DES daily fuel is stored in another column, change only this number.
' Set 0 to disable DES fuel reading.
Private Const DES_FUEL_COL As Long = 0

Private Const BOILERS_FUEL_COL As Long = 19    ' S, daily fuel

Public Sub RefreshMonthData()
    Dim folderPath As String
    Dim fileName As String
    Dim fullPath As String
    Dim wb As Workbook
    Dim wsSummary As Worksheet, wsRepairs As Worksheet, wsReasons As Worksheet
    Dim wsFiles As Worksheet, wsDash As Worksheet
    Dim dictSummary As Object, dictReasons As Object
    Dim repairsRow As Long, filesRow As Long
    Dim reportName As String
    Dim dt As Variant

    On Error GoTo EH

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = "Refreshing report..."

    folderPath = ThisWorkbook.Path
    If Len(folderPath) = 0 Then
        MsgBox "Save the report file into the source files folder first.", vbExclamation
        GoTo SafeExit
    End If

    reportName = ThisWorkbook.Name

    Set dictSummary = CreateObject("Scripting.Dictionary")
    Set dictReasons = CreateObject("Scripting.Dictionary")

    PrepareSheets wsDash, wsSummary, wsRepairs, wsReasons, wsFiles

    repairsRow = 2
    filesRow = 2

    fileName = Dir(folderPath & "\*.xls*")
    Do While fileName <> ""
        If LCase(fileName) <> LCase(reportName) Then
            If Left$(fileName, 2) <> "~$" Then
                fullPath = folderPath & "\" & fileName
                dt = ExtractDateFromFilename(fileName)

                If IsDate(dt) Then
                    Set wb = Nothing
                    On Error Resume Next
                    Set wb = Workbooks.Open(Filename:=fullPath, ReadOnly:=True, UpdateLinks:=False, IgnoreReadOnlyRecommended:=True)
                    On Error GoTo EH

                    If Not wb Is Nothing Then
                        ProcessWorkbook wb, CDate(dt), fileName, dictSummary, dictReasons, wsRepairs, repairsRow, wsFiles, filesRow
                        wb.Close SaveChanges:=False
                        Set wb = Nothing
                    Else
                        LogFile wsFiles, filesRow, fileName, CDate(dt), "Error", "Cannot open file"
                        filesRow = filesRow + 1
                    End If
                Else
                    LogFile wsFiles, filesRow, fileName, Empty, "Skipped", "Date not found in filename"
                    filesRow = filesRow + 1
                End If
            End If
        End If
        fileName = Dir
    Loop

    WriteSummary wsSummary, dictSummary
    WriteReasons wsReasons, dictReasons
    BuildDashboard wsDash, wsSummary, wsReasons, wsFiles
    FormatSheets wsSummary, wsRepairs, wsReasons, wsFiles, wsDash

    MsgBox "Update completed.", vbInformation

SafeExit:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False
    Exit Sub

EH:
    MsgBox "Update error: " & Err.Description, vbCritical
    Resume SafeExit
End Sub

Public Sub CreateRefreshButton()
    Dim ws As Worksheet
    Dim shp As Shape

    Set ws = GetOrCreateSheetSafe(REPORT_SHEET_DASH)

    On Error Resume Next
    ws.Shapes("btnRefresh").Delete
    On Error GoTo 0

    Set shp = ws.Shapes.AddShape(msoShapeRoundedRectangle, 700, 20, 180, 35)
    shp.Name = "btnRefresh"
    shp.TextFrame.Characters.Text = "Refresh data"
    shp.OnAction = "RefreshMonthData"
End Sub

Private Sub PrepareSheets(ByRef wsDash As Worksheet, ByRef wsSummary As Worksheet, ByRef wsRepairs As Worksheet, ByRef wsReasons As Worksheet, ByRef wsFiles As Worksheet)
    Set wsDash = GetOrCreateSheetSafe(REPORT_SHEET_DASH)
    Set wsSummary = GetOrCreateSheetSafe(REPORT_SHEET_SUMMARY)
    Set wsRepairs = GetOrCreateSheetSafe(REPORT_SHEET_REPAIRS)
    Set wsReasons = GetOrCreateSheetSafe(REPORT_SHEET_REASONS)
    Set wsFiles = GetOrCreateSheetSafe(REPORT_SHEET_FILES)

    wsDash.Cells.Clear
    wsSummary.Cells.Clear
    wsRepairs.Cells.Clear
    wsReasons.Cells.Clear
    wsFiles.Cells.Clear

    wsSummary.Range("A1:J1").Value = Array( _
        "Date", "Files", "Repairs", "DES Load kW", "Boilers Fuel", _
        "DES Fuel", "Total Fuel", "DG Running", "DG Reserve", "DG Repair")

    wsRepairs.Range("A1:F1").Value = Array("Date", "Source", "Object/Equipment", "Reason", "Note", "Source File")
    wsReasons.Range("A1:B1").Value = Array("Reason", "Count")
    wsFiles.Range("A1:D1").Value = Array("File", "Date", "Status", "Comment")
End Sub

Private Sub ProcessWorkbook(ByVal wb As Workbook, ByVal dt As Date, ByVal fileName As String, ByVal dictSummary As Object, ByVal dictReasons As Object, ByVal wsRepairs As Worksheet, ByRef repairsRow As Long, ByVal wsFiles As Worksheet, ByRef filesRow As Long)
    Dim desLoad As Double
    Dim boilersFuel As Double
    Dim desFuel As Double
    Dim totalFuel As Double
    Dim cntRepairs As Long
    Dim cntWork As Long, cntReserve As Long, cntRepairState As Long
    Dim okAny As Boolean

    okAny = False

    desLoad = ReadDESLoadAndStatus(wb, cntWork, cntReserve, cntRepairState)
    If desLoad <> 0 Or cntWork <> 0 Or cntReserve <> 0 Or cntRepairState <> 0 Then okAny = True

    boilersFuel = ReadBoilersFuel(wb)
    If boilersFuel <> 0 Then okAny = True

    desFuel = ReadDESFuel(wb)
    If desFuel <> 0 Then okAny = True

    totalFuel = boilersFuel + desFuel

    cntRepairs = ReadRepairs(wb, dt, fileName, dictReasons, wsRepairs, repairsRow)
    If cntRepairs <> 0 Then okAny = True

    AddSummary dictSummary, dt, 1, cntRepairs, desLoad, boilersFuel, desFuel, totalFuel, cntWork, cntReserve, cntRepairState

    If okAny Then
        LogFile wsFiles, filesRow, fileName, dt, "OK", "Processed"
    Else
        LogFile wsFiles, filesRow, fileName, dt, "OK", "Opened, but data not recognized"
    End If
    filesRow = filesRow + 1
End Sub

Private Function ReadDESLoadAndStatus(ByVal wb As Workbook, ByRef cntWork As Long, ByRef cntReserve As Long, ByRef cntRepairState As Long) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim vWork As Variant, vReserve As Variant, vRepair As Variant
    Dim vLoad As Variant
    Dim totalLoad As Double
    Dim idVal As Variant, nameVal As Variant

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = LastUsedRow(ws)
    totalLoad = 0

    For r = 1 To lastRow
        idVal = ws.Cells(r, 1).Value
        nameVal = ws.Cells(r, 2).Value

        If Not IsEmpty(idVal) And Not IsEmpty(nameVal) Then
            If IsNumeric(idVal) Then
                vWork = ws.Cells(r, DES_COL_RUNNING).Value
                vReserve = ws.Cells(r, DES_COL_RESERVE).Value
                vRepair = ws.Cells(r, DES_COL_REPAIR).Value
                vLoad = ws.Cells(r, DES_COL_LOAD).Value

                If Trim$(CStr(vWork)) = "+" Then cntWork = cntWork + 1
                If Trim$(CStr(vReserve)) = "+" Then cntReserve = cntReserve + 1

                If LCase$(Trim$(CStr(vRepair))) = "repair" Or LCase$(Trim$(CStr(vRepair))) = "remont" Or Trim$(CStr(vRepair)) = "+" Then
                    cntRepairState = cntRepairState + 1
                End If

                If IsNumeric(vLoad) Then
                    totalLoad = totalLoad + CDbl(vLoad)
                End If
            End If
        End If
    Next r

    ReadDESLoadAndStatus = totalLoad
End Function

Private Function ReadDESFuel(ByVal wb As Workbook) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim fuelVal As Variant
    Dim totalFuel As Double
    Dim idVal As Variant, nameVal As Variant

    If DES_FUEL_COL <= 0 Then Exit Function

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_DES)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = LastUsedRow(ws)
    totalFuel = 0

    For r = 1 To lastRow
        idVal = ws.Cells(r, 1).Value
        nameVal = ws.Cells(r, 2).Value

        If Not IsEmpty(idVal) And Not IsEmpty(nameVal) Then
            If IsNumeric(idVal) Then
                fuelVal = ws.Cells(r, DES_FUEL_COL).Value
                If IsNumeric(fuelVal) Then
                    totalFuel = totalFuel + CDbl(fuelVal)
                End If
            End If
        End If
    Next r

    ReadDESFuel = totalFuel
End Function

Private Function ReadBoilersFuel(ByVal wb As Workbook) As Double
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim fuelVal As Variant
    Dim totalFuel As Double

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_BOILERS)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = LastUsedRow(ws)
    totalFuel = 0

    For r = 1 To lastRow
        fuelVal = ws.Cells(r, BOILERS_FUEL_COL).Value
        If IsNumeric(fuelVal) Then
            totalFuel = totalFuel + CDbl(fuelVal)
        End If
    Next r

    ReadBoilersFuel = totalFuel
End Function

Private Function ReadRepairs(ByVal wb As Workbook, ByVal dt As Date, ByVal fileName As String, ByVal dictReasons As Object, ByVal wsRepairs As Worksheet, ByRef repairsRow As Long) As Long
    Dim ws As Worksheet
    Dim lastRow As Long, r As Long
    Dim unitNo As Variant
    Dim typeVal As String, engineVal As String
    Dim reasonVal As String, noteVal As String
    Dim cnt As Long

    On Error Resume Next
    Set ws = wb.Worksheets(SRC_SHEET_REPAIRS)
    On Error GoTo 0
    If ws Is Nothing Then Exit Function

    lastRow = LastUsedRow(ws)
    cnt = 0

    For r = 3 To lastRow
        unitNo = ws.Cells(r, 2).Value
        typeVal = Trim$(CStr(ws.Cells(r, 3).Value))
        engineVal = Trim$(CStr(ws.Cells(r, 4).Value))
        reasonVal = Trim$(CStr(ws.Cells(r, 6).Value))
        noteVal = Trim$(CStr(ws.Cells(r, 8).Value))

        If reasonVal <> "" Then
            If IsNumeric(unitNo) Then
                wsRepairs.Cells(repairsRow, 1).Value = dt
                wsRepairs.Cells(repairsRow, 2).Value = "Equipment repair"
                wsRepairs.Cells(repairsRow, 3).Value = Trim$(typeVal & " " & engineVal)
                wsRepairs.Cells(repairsRow, 4).Value = reasonVal
                wsRepairs.Cells(repairsRow, 5).Value = noteVal
                wsRepairs.Cells(repairsRow, 6).Value = fileName

                repairsRow = repairsRow + 1
                cnt = cnt + 1

                If dictReasons.Exists(reasonVal) Then
                    dictReasons(reasonVal) = CLng(dictReasons(reasonVal)) + 1
                Else
                    dictReasons.Add reasonVal, 1
                End If
            End If
        End If
    Next r

    ReadRepairs = cnt
End Function

Private Sub AddSummary(ByVal dictSummary As Object, ByVal dt As Date, ByVal fileCount As Long, ByVal repairCount As Long, ByVal desLoad As Double, ByVal boilersFuel As Double, ByVal desFuel As Double, ByVal totalFuel As Double, ByVal workCnt As Long, ByVal reserveCnt As Long, ByVal repairStateCnt As Long)
    Dim key As String
    Dim arr As Variant

    key = Format$(dt, "yyyy-mm-dd")

    If dictSummary.Exists(key) Then
        arr = dictSummary(key)
    Else
        ReDim arr(1 To 9)
        arr(1) = 0
        arr(2) = 0
        arr(3) = 0#
        arr(4) = 0#
        arr(5) = 0#
        arr(6) = 0#
        arr(7) = 0
        arr(8) = 0
        arr(9) = 0
    End If

    arr(1) = arr(1) + fileCount
    arr(2) = arr(2) + repairCount
    arr(3) = arr(3) + desLoad
    arr(4) = arr(4) + boilersFuel
    arr(5) = arr(5) + desFuel
    arr(6) = arr(6) + totalFuel
    arr(7) = arr(7) + workCnt
    arr(8) = arr(8) + reserveCnt
    arr(9) = arr(9) + repairStateCnt

    dictSummary(key) = arr
End Sub

Private Sub WriteSummary(ByVal ws As Worksheet, ByVal dictSummary As Object)
    Dim keys As Variant, i As Long, r As Long, arr As Variant

    If dictSummary.Count = 0 Then Exit Sub

    keys = dictSummary.Keys
    SortStringDates keys

    r = 2
    For i = LBound(keys) To UBound(keys)
        arr = dictSummary(keys(i))
        ws.Cells(r, 1).Value = CDate(keys(i))
        ws.Cells(r, 2).Value = arr(1)
        ws.Cells(r, 3).Value = arr(2)
        ws.Cells(r, 4).Value = arr(3)
        ws.Cells(r, 5).Value = arr(4)
        ws.Cells(r, 6).Value = arr(5)
        ws.Cells(r, 7).Value = arr(6)
        ws.Cells(r, 8).Value = arr(7)
        ws.Cells(r, 9).Value = arr(8)
        ws.Cells(r, 10).Value = arr(9)
        r = r + 1
    Next i
End Sub

Private Sub WriteReasons(ByVal ws As Worksheet, ByVal dictReasons As Object)
    Dim keys As Variant, i As Long, r As Long
    Dim lastRow As Long

    If dictReasons.Count = 0 Then Exit Sub

    keys = dictReasons.Keys
    r = 2

    For i = LBound(keys) To UBound(keys)
        ws.Cells(r, 1).Value = keys(i)
        ws.Cells(r, 2).Value = dictReasons(keys(i))
        r = r + 1
    Next i

    lastRow = LastUsedRow(ws)
    If lastRow >= 2 Then
        ws.Range("A1:B" & lastRow).Sort Key1:=ws.Range("B2"), Order1:=xlDescending, Header:=xlYes
    End If
End Sub

Private Sub BuildDashboard(ByVal wsDash As Worksheet, ByVal wsSummary As Worksheet, ByVal wsReasons As Worksheet, ByVal wsFiles As Worksheet)
    Dim lastSummaryRow As Long, lastReasonsRow As Long
    Dim ch As ChartObject

    wsDash.Cells.Clear

    wsDash.Range("A1").Value = "Monthly Dashboard"
    wsDash.Range("A1").Font.Size = 18
    wsDash.Range("A1").Font.Bold = True

    wsDash.Range("A3").Value = "Files processed"
    wsDash.Range("B3").Formula = "=MAX(0,COUNTA(Files!A:A)-1)"

    wsDash.Range("D3").Value = "Days with data"
    wsDash.Range("E3").Formula = "=MAX(0,COUNTA(Summary!A:A)-1)"

    wsDash.Range("A4").Value = "Total repairs"
    wsDash.Range("B4").Formula = "=SUM(Summary!C:C)"

    wsDash.Range("D4").Value = "Total DES load"
    wsDash.Range("E4").Formula = "=SUM(Summary!D:D)"

    wsDash.Range("A5").Value = "Boilers fuel"
    wsDash.Range("B5").Formula = "=SUM(Summary!E:E)"

    wsDash.Range("D5").Value = "DES fuel"
    wsDash.Range("E5").Formula = "=SUM(Summary!F:F)"

    wsDash.Range("A6").Value = "Total fuel"
    wsDash.Range("B6").Formula = "=SUM(Summary!G:G)"

    wsDash.Range("D6").Value = "Last date"
    wsDash.Range("E6").Formula = "=MAX(Summary!A:A)"
    wsDash.Range("E6").NumberFormat = "dd.mm.yyyy"

    lastSummaryRow = LastUsedRow(wsSummary)
    lastReasonsRow = LastUsedRow(wsReasons)

    DeleteAllCharts wsDash

    If lastSummaryRow >= 2 Then
        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=120, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlColumnClustered
            ClearSeries ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Repairs"""
            .SeriesCollection(1).XValues = wsSummary.Range("A2:A" & lastSummaryRow)
            .SeriesCollection(1).Values = wsSummary.Range("C2:C" & lastSummaryRow)
            .HasTitle = True
            .ChartTitle.Text = "Repairs by day"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=460, Top:=120, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlLine
            ClearSeries ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""DES load"""
            .SeriesCollection(1).XValues = wsSummary.Range("A2:A" & lastSummaryRow)
            .SeriesCollection(1).Values = wsSummary.Range("D2:D" & lastSummaryRow)
            .HasTitle = True
            .ChartTitle.Text = "DES load by day"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=360, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlLine
            ClearSeries ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Total fuel"""
            .SeriesCollection(1).XValues = wsSummary.Range("A2:A" & lastSummaryRow)
            .SeriesCollection(1).Values = wsSummary.Range("G2:G" & lastSummaryRow)
            .HasTitle = True
            .ChartTitle.Text = "Total fuel by day"
        End With

        Set ch = wsDash.ChartObjects.Add(Left:=460, Top:=360, Width:=420, Height:=220)
        With ch.Chart
            .ChartType = xlColumnClustered
            ClearSeries ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""DG status"""
            .SeriesCollection(1).XValues = Array("Running", "Reserve", "Repair")
            .SeriesCollection(1).Values = Array(wsSummary.Cells(lastSummaryRow, 8).Value, wsSummary.Cells(lastSummaryRow, 9).Value, wsSummary.Cells(lastSummaryRow, 10).Value)
            .HasTitle = True
            .ChartTitle.Text = "DG status"
        End With
    End If

    If lastReasonsRow >= 2 Then
        Set ch = wsDash.ChartObjects.Add(Left:=20, Top:=600, Width:=860, Height:=250)
        With ch.Chart
            .ChartType = xlBarClustered
            ClearSeries ch.Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).Name = "=""Reasons"""
            .SeriesCollection(1).XValues = wsReasons.Range("A2:A" & WorksheetFunction.Min(lastReasonsRow, 11))
            .SeriesCollection(1).Values = wsReasons.Range("B2:B" & WorksheetFunction.Min(lastReasonsRow, 11))
            .HasTitle = True
            .ChartTitle.Text = "Top repair reasons"
        End With
    End If
End Sub

Private Sub ClearSeries(ByVal ch As Chart)
    On Error Resume Next
    Do While ch.SeriesCollection.Count > 0
        ch.SeriesCollection(1).Delete
    Loop
    On Error GoTo 0
End Sub

Private Sub DeleteAllCharts(ByVal ws As Worksheet)
    Dim i As Long
    For i = ws.ChartObjects.Count To 1 Step -1
        ws.ChartObjects(i).Delete
    Next i
End Sub

Private Sub FormatSheets(ByVal wsSummary As Worksheet, ByVal wsRepairs As Worksheet, ByVal wsReasons As Worksheet, ByVal wsFiles As Worksheet, ByVal wsDash As Worksheet)
    FormatOneSheet wsSummary
    FormatOneSheet wsRepairs
    FormatOneSheet wsReasons
    FormatOneSheet wsFiles

    wsSummary.Columns("A").NumberFormat = "dd.mm.yyyy"
    wsRepairs.Columns("A").NumberFormat = "dd.mm.yyyy"
    wsFiles.Columns("B").NumberFormat = "dd.mm.yyyy"

    wsDash.Columns("A:F").ColumnWidth = 16
    wsDash.Range("A3:E6").Font.Bold = True
End Sub

Private Sub FormatOneSheet(ByVal ws As Worksheet)
    With ws.Rows(1)
        .Font.Bold = True
        .Interior.Color = RGB(217, 225, 242)
    End With

    ws.Cells.EntireColumn.AutoFit

    On Error Resume Next
    ws.Rows(1).AutoFilter
    On Error GoTo 0
End Sub

Private Sub LogFile(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal fileName As String, ByVal dt As Variant, ByVal statusText As String, ByVal commentText As String)
    ws.Cells(rowNum, 1).Value = fileName
    If IsDate(dt) Then ws.Cells(rowNum, 2).Value = CDate(dt)
    ws.Cells(rowNum, 3).Value = statusText
    ws.Cells(rowNum, 4).Value = commentText
End Sub

Private Function GetOrCreateSheetSafe(ByVal sheetName As String) As Worksheet
    Dim ws As Worksheet
    Dim candidate As String
    Dim i As Long

    For Each ws In ThisWorkbook.Worksheets
        If LCase$(ws.Name) = LCase$(sheetName) Then
            Set GetOrCreateSheetSafe = ws
            Exit Function
        End If
    Next ws

    Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))

    candidate = CleanSheetName(sheetName)
    If candidate = "" Then candidate = "SheetX"

    On Error Resume Next
    ws.Name = candidate
    If Err.Number = 0 Then
        On Error GoTo 0
        Set GetOrCreateSheetSafe = ws
        Exit Function
    End If
    Err.Clear

    For i = 1 To 99
        ws.Name = Left$(candidate, 28) & "_" & CStr(i)
        If Err.Number = 0 Then Exit For
        Err.Clear
    Next i
    On Error GoTo 0

    Set GetOrCreateSheetSafe = ws
End Function

Private Function CleanSheetName(ByVal s As String) As String
    Dim badChars As Variant
    Dim ch As Variant

    badChars = Array(":", "\", "/", "?", "*", "[", "]")
    CleanSheetName = Trim$(s)

    For Each ch In badChars
        CleanSheetName = Replace(CleanSheetName, CStr(ch), "")
    Next ch

    If Len(CleanSheetName) > 31 Then
        CleanSheetName = Left$(CleanSheetName, 31)
    End If
End Function

Private Function ExtractDateFromFilename(ByVal fileName As String) As Variant
    Dim re As Object, m As Object
    Dim d As Integer, mn As Integer, y As Integer

    Set re = CreateObject("VBScript.RegExp")
    re.Global = False
    re.IgnoreCase = True
    re.Pattern = "(\d{1,2})[.\-_](\d{1,2})[.\-_](\d{4})"

    If re.Test(fileName) Then
        Set m = re.Execute(fileName)(0)
        d = CInt(m.SubMatches(0))
        mn = CInt(m.SubMatches(1))
        y = CInt(m.SubMatches(2))
        On Error Resume Next
        ExtractDateFromFilename = DateSerial(y, mn, d)
        If Err.Number <> 0 Then ExtractDateFromFilename = Empty
        On Error GoTo 0
    Else
        ExtractDateFromFilename = Empty
    End If
End Function

Private Function LastUsedRow(ByVal ws As Worksheet) As Long
    Dim f As Range

    On Error Resume Next
    Set f = ws.Cells.Find(What:="*", After:=ws.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    On Error GoTo 0

    If f Is Nothing Then
        LastUsedRow = 1
    Else
        LastUsedRow = f.Row
    End If
End Function

Private Function LastUsedColInRow(ByVal ws As Worksheet, ByVal rowNum As Long) As Long
    LastUsedColInRow = ws.Cells(rowNum, ws.Columns.Count).End(xlToLeft).Column
    If LastUsedColInRow < 1 Then LastUsedColInRow = 1
End Function

Private Sub SortStringDates(ByRef arr As Variant)
    Dim i As Long, j As Long
    Dim tmp As Variant

    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If CDate(arr(j)) < CDate(arr(i)) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
End Sub