Keep sheets based on color and copy paste as values. Delete the remaining ones

I have the following macro that should keep the tabs that have a specific color, turn them to values and delete all the other. The color part works in another macro that I use to PDF the sheets but not here. The second For works as well. But put together, the workbook freezes and nothing happens. Can someone point me in a direction about it?

Option Explicit

Sub test()
MsgBox (Sheets("Sheet1").Tab.ColorIndex)


End Sub

Sub ExportAsPDFSTN()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
    Dim strName As String, strPathFile As String, wsNames() As String
    Dim ws As Worksheet
    Dim wsColor() As Integer, ind As Integer
    Dim Matched As Boolean
    Dim wshtName As Variant 
      ReDim wsNames(0)
         ReDim wsColor(0)
            wsNames(0) = ThisWorkbook.Sheets("Cover").Name

    strName = ThisWorkbook.Sheets("Admin").Range("A5").Value
             Application.CalculateUntilAsyncQueriesDone
        Do While Application.CalculationState <> xlDone
          DoEvents
              Loop
      For Each ws In ThisWorkbook.Sheets
    If ws.Tab.ColorIndex = wsColor(0) And ws.Visible = xlSheetVisible Then
      ReDim Preserve wsNames(UBound(wsNames) + 1)
      ReDim Preserve wsColor(UBound(wsColor) + 1)
      wsNames(UBound(wsNames)) = ws.Name
      wsColor(UBound(wsColor)) = ws.Tab.ColorIndex
    End If
      Next ws

  For Each ws In ThisWorkbook.Worksheets
        Matched = False
        For Each wshtName In wsNames
            If wshtName = ws.Name Then
                Matched = True
                With ws.UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
        End With
        Application.CutCopyMode = False
            End If
        Next
        If Not Matched Then
            ws.Delete
        End If
    Next ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
 
 ThisWorkbook.Sheets("Admin").Activate
 ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Distributed\" & strName
 
End Sub

wsColor(0) is never set so will probably equal zero which won't match any sheets. Perhaps you need somewhere:

wsColor(0) = ThisWorkbook.Sheets("Cover").Tab.ColorIndex

Probably after the line that sets wsNames(0).

WBD

Oh, I cleaned the macro and removed that line by mistake. I already have it my actual file set, but unfortunately it still not works.

Can you redact the data and attach a copy of the file? Would probably be trivial to diagnose then but almost impossible without having a copy of the file.

WBD

In case someone will find this thread, here is a solution. Not sure why I overcomplicated the problem.

Sub ExportAsPDFSTN()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
    Dim strPath As String, strName As String, strPathFile As String, wsNames() As String
    Dim ws As Worksheet
    Dim wsColor() As Integer
      ReDim wsNames(0)
        ReDim wsColor(0)
          wsNames(0) = ThisWorkbook.Sheets("Cover").Name
          wsColor(0) = ThisWorkbook.Sheets("Cover").Tab.ColorIndex

    strName = ThisWorkbook.Sheets("Admin").Range("A5").Value & " " & ThisWorkbook.Sheets("Cover").Range("B41")
     Application.CalculateUntilAsyncQueriesDone
Do While Application.CalculationState <> xlDone
   DoEvents
Loop
     For Each ws In ThisWorkbook.Sheets
    If ws.Tab.ColorIndex = wsColor(0) Then
        With ws.UsedRange
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
        End With
        ws.Visible = xlSheetVisible
        Else
        ws.Delete
    End If
  Next ws
  
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
 
 ThisWorkbook.Sheets("Admin").Activate
 ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Distributed\" & strName
 
End Sub