Automatically change file name when conditional formula is true

Hello everyone,

I hope you're all fine today. I've developed VBA code (below) that generates Excel files based on a template excel file(attached below). Now, I'm seeking assistance to further automate the process for working with these generated XLSX files.

Specifically, I need help with a single automation step that involves renaming these Excel files. The renaming should only occur when a certain condition is met, indicated by the presence of a highlighted green color in column A, indicating condition is achieved.

To elaborate, I'm looking for a way to automatically add the word "checked" to the excel filename if and only if the condition(green color) in the file is satisfied. The condition is related to a specific formula in column A (sheet 1), which is to highlight $A$1:$A$2040 in green.

I'm open to any suggestions on how to achieve this automation in the most efficient manner and that requires minimal CPU power.

Thank you in advance for your support and expertise.

    Sub test()
    Dim rg As Range, i As Long, wb As Workbook
    Dim vNames As Variant, v As Variant
    Dim ws As Worksheet

    On Error Resume Next
    Set wb = Workbooks("o.csv")
    On Error GoTo 0
    If wb Is Nothing Then
        MsgBox "The workbook o.csv is not open."
        Exit Sub
    End If

    On Error Resume Next
    Set ws = wb.Worksheets("o")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "The worksheet o is not found in the workbook o.csv."
        Exit Sub
    End If

    Set rg = ws.UsedRange

    'get unique names
    With CreateObject("Scripting.Dictionary")
        For i = 2 To rg.Rows.Count
            On Error Resume Next
            .Item(rg.Cells(i, 1).Value) = Empty
        Next i
        vNames = .Keys
    End With

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    'save a copy of the original workbook before making changes to it
    wb.SaveCopyAs ThisWorkbook.Path & "\" & "o_backup"

    For Each v In vNames
        On Error Resume Next
        ThisWorkbook.Worksheets("Sheet1").Copy
        Set wb = ActiveWorkbook
        Dim timestamp As String
        timestamp = Format(Now, "mmmm dd, yyyy hhmmss AMPM") ' create timestamp
        timestamp = Replace(timestamp, "AM", "am", , , vbTextCompare)
        timestamp = Replace(timestamp, "PM", "pm", , , vbTextCompare)
        wb.SaveAs ThisWorkbook.Path & "\" & v & "_" & timestamp, 51
        rg.AutoFilter 1, v
        rg.AutoFilter 17, "<>0"
        rg.Offset(1).Columns("A").SpecialCells(xlCellTypeVisible).Copy wb.Worksheets(1).Cells(2, 2)
        rg.Offset(1).Columns("E").SpecialCells(xlCellTypeVisible).Copy wb.Worksheets(1).Cells(2, 25)
        rg.Offset(1).Columns("U").SpecialCells(xlCellTypeVisible).Copy wb.Worksheets(1).Cells(2, 12)
        rg.Offset(1).Columns("Q").SpecialCells(xlCellTypeVisible).Copy wb.Worksheets(1).Cells(2, 19)
        With Worksheets("Sheet1")
            With .Range("B2:Z2040")
                .Font.Size = 19
                .Font.Name = "Times New Roman"
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            .Range("C2:C2040").Locked = False
            .Range("B2:B2040").Locked = False
            .Protect AllowFiltering:=True
            .EnableSelection = xlUnlockedCells
        End With
        wb.Close SaveChanges:=True
    Next v
    Application.ScreenUpdating = True
    MsgBox "Completed"
    Application.DisplayAlerts = True
End Sub