VBA required to keep specific sheets & rest all to be deleted

No Sir, as per the attached sample sheet in above thread,

code should keep the sheets (SheetA-Approved,SheetB,SheetC and Sheet1) & rest of the sheets has to be Hidded / Deleted.

but after running code, it keeps the following sheets only (SheetB,SheetC and Sheet1)

SheetA-Approved is not considered as its not exactly matching...

i m requesting solution for this issue Sir.

If x = 0 And sh.Name <> "SheetA-Approved" Then sh.Visible = xlSheetVeryHidden

Sir, as "SheetA-Approved" is added in the code, now its considering & working fine Sir,

but actually the problem is ....i have many cases like this.....

(sometimes it comes as SheetA-Appr, SheetB- correct, Pending SheetA-Appr)

the red texts are the additional part of the sheet names,

so i m requesting for code to search for Approx Match Sir

as per Mr.Dave suggestion, i used this line, but not happening...

x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), "*" & s & "*")

Sir, is it possible to check the match for first 5 characters of Sheet name & do that work ?

Because due to this part of work, makes more worload as it contains bulk files, so please check for possibilities if any Sir

Quote from dxstudios

match for first 5 character

match for first 6 character of sheet name

Sir, not only the word "SheetA,SheetB" some it may be (Page1, Page2, countA, countB)

So i am asking to match atleast first 6 characters,

Sir, i have tried modifiying the code as per your suggestion,

Actually i have 2 type of files (Vendor 1 & Vendor 2)

it works fine for the Vendor 1 files, but not working on the Vendor 2 type files....

here in Vendor 2 files, everything same as vendor 1, only the terminology changes.

attaching both type of files for your reference Sir

vendor1.zip

vendor 2.zip

Option Explicit

Sub LoopThroughFolder()
Dim MyDir As String, fn As String, i As Long, e, flg As Boolean
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then MyDir = .SelectedItems(1) & "\"
End With
If MyDir = "" Then Exit Sub
Dim MyFile As String, Str As String
Dim Rws As Long, rng As Range
'--------------------
Dim sh As Worksheet
Dim c As Range, ws As Worksheet
Dim s As String, x As Integer
'---------------------
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'change the address to suite
'MyDir = "C:\Users\f\Desktop\not req\"
MyFile = Dir(MyDir & "*.xlsx") 'change file extension
ChDir MyDir
Do While MyFile <> ""
Workbooks.Open (MyFile)
'-----------------------
Set ws = ActiveWorkbook.Sheets("START")
With ws
Rws = .Cells(Rows.Count, "E").End(xlUp).Row
Set rng = ws.Range(.Cells(2, "E"), .Cells(Rws, "E"))
For Each c In rng.Cells
If c Like "*Proceed*" Then
c.EntireRow.Interior.ColorIndex = 16
End If
Next c
For Each sh In ActiveWorkbook.Sheets
s = sh.Name
If sh.Name <> ws.Name Then
x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), Left(sh.Name, 6))
If x = 0 Then sh.Visible = xlSheetVeryHidden
End If
Next sh
'----------------------------
ActiveWorkbook.Close True
End With
MyFile = Dir()
Loop
MsgBox "Unwanted Sheets Removed from All files!"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

vendor 2.zip

Could someone please help me to complete my task

Sir,

sorry, its my mistake ....i should have share this files earlier itself..

actually i thought like Existing code provided by you will work for Vendor 2 type files also.....but no luck

let me explain the Vendor 2 type files,

Here in B:B range, name of the sheets are mentioned as mix of Alphabetic characters like NNIM, ARDR-2, LWIS, Sheet1.... etc.,

i tried with the existing code, it consider only the Sheet1 from the above list, rest of the sheets names are getting hided.

in earlier files sheet names are mentioned as Sheet1,Sheet2,SheetA,.... etc.,

so its working fine,

Now i need to make it work on the Vendor2 Type files....like it should consider that mix of Alphabetical characters also ...