Posts by dxstudios

Thank you so much for this valuable Help Mr.royUK

please ignore the above thread , its working fine Sir , Thank you so much for your Help

Thank you so much for looking on my thread Mr.royUK,

i have attached the sample sheet with the existing code on it.

Book1.xlsm

could someone please help me on this thread.

Hi Friends,

i have task to replace some particular Text in a range of cells, i have a existing code, which replaces text properly,

but now my ask is just to replace the Text only at the lastpart of the Text,

it should not replace the text in the start Text / Middle Text, it should get replaced only at the End.

ActiveSheet.Range("A:A").Replace " LAKE", " LK"
ActiveSheet.Range("A:A").Replace " ROAD", " RD"
ActiveSheet.Range("A:A").Replace " STREET", " ST"
ActiveSheet.Range("A:A").Replace " DRIVE", " DR"

for example:

existing code converts like :

Lakeshore Road to LKshore RD

code required:

Lakeshore Road to Lakeshore RD

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 ...

Could someone please help me to complete my task

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

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,

Quote from dxstudios

match for first 5 character

match for first 6 character of sheet name

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

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 & "*")

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.

i tried with the above code Sir, still the same issue ....SheetA-Approved getting hided,

here i am attaching that sheet ..workbook sample (1).xlsx

Quote from royUK

Then I need to see that code

this is the code i m using it in personal workbook Sir

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, Wb As Workbook
 Dim Rws As Long, rng As Range
 '--------------------
 Dim sh As Worksheet
 Dim c As Range, ws As Worksheet
 Dim s As String, x
 
 '---------------------
 Set Wb = ThisWorkbook
 'change the address to suite
 'MyDir = "C:\Users\f\Desktop\not req\"
 MyFile = Dir(MyDir & "*.xlsx") 'change file extension
 ChDir MyDir
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 
 Do While MyFile <> ""
 Workbooks.Open (MyFile)
 '-----------------------
 Set ws = Sheets("START")
 With ws
 Rws = .Cells(Rows.Count, "E").End(xlUp).Row
 Set rng = 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 Sheets
 s = sh.Name
 If sh.Name <> ws.Name Then
 x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), "*" & s & "*")
 ''x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), s)
  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!"
End Sub

Quote from royUK

Which workbook contains the code that you are using?

Sir, i m running code by opening a new xl sheet & personal workbook macro....i m running these codes

Thank you Sir,

I replaced below line of code, working fine, but how to check that hidden sheets manually

If x = 0 Then sh.Visible = xlsheetveryhidden

Sir,

Instead of Delete, i m using Hide option.

 For Each sh In Sheets
 s = sh.Name
 If sh.Name <> ws.Name Then
 x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), "*" & s & "*")
 ''x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), s)
  If x = 0 Then sh.Visible = False
 End If
 Next sh

Thank you so much for quick reply Both of you Sir,

i just checked with the code....but not no luck still the same ....

i m attaching the sample workbook & screenshot.

Kindly have a look on it Sir.

not req (2).zipnot req (2).zip

For Each sh In Sheets
 s = sh.Name
 If sh.Name <> ws.Name Then
 x = Application.WorksheetFunction.CountIf(ws.Range("B:B"), s)
 If x = 0 Then sh.Delete
 End If
 Next sh

Sir,

Here the code looks for the sheet name with Exact names in range (B:B)

is it possible to find the approximate matches?

for example:

if the name appears as Sheet1 in B:B & sheet name comes as Sheet1-Approved

since the sheet name contains additional words (-Approved) in its names, code not considering it.

Please Help me Sir.