Reputation: 39
I've just written some code to go through all files within a folder, search the workbooks for sheets of specific names, and then remove all said sheets (see below - I'm sure there are cleaner ways of writing it, but I'm not a dev). What I'm left with are sheets that aren't in order (i.e. sheet1, sheet2, sheet4, sheet5 - missing sheet3). What I want to do is shift the names of all the sheets down based on the sheets missing, so sheet4 in the example above, would become sheet3 etc. But there are also other sheets missing later on in the workbook (i.e sheet40, sheet41, sheet43 - missing sheet 42), which would mean that the later sheets would have to move X number of spaces depending on the number of sheets that are missing.
The only way that I can think of it working, would be to create a list of all the sheets that should be there, i.e. sheet1 through to sheetX, and then reference this list when renaming the existing sheets. Am I even close?
Sub AllFiles()
Dim folderPath As String
Dim filename As String
Dim wb As Workbook
folderPath = "C:\Users\user1\OneDrive\Desktop\something\macro_test\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
filename = Dir(folderPath & "*.xls")
Do While filename <> ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)
'Call a subroutine here to operate on the just-opened workbook
Call Mymacro
filename = Dir
Loop
Application.ScreenUpdating = True End Sub
Sub Mymacro()
Application.DisplayAlerts = False
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = "code_D_1" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_2" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_3" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_4" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_5" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_6" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_7" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_8" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_9" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_10" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_11" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_12" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_13" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_14" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_15" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_16" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_17" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_18" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_19" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_20" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_21" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_22" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_23" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_24" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_25" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_26" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_27" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_28" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_29" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_30" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_31" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_32" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_33" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_34" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_35" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_36" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_37" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_38" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_39" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_40" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_41" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_42" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_43" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_44" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_45" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_46" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_47" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_48" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_49" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_50" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_51" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_52" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_53" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_54" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_55" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_56" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_57" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_58" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_59" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_60" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_61" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_62" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_63" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_64" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_65" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_66" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_67" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_68" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_69" Then
Sheet.Delete
ElseIf Sheet.Name = "code_D_70" Then
Sheet.Delete
End If
Next Sheet
End Sub
Upvotes: 1
Views: 380
Reputation: 54807
AllFiles
procedure. The other two are being called by it.Option Explicit
Sub AllFiles()
Dim FolderPath As String
FolderPath = "C:\Users\user1\OneDrive\Desktop\something\macro_test\"
If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
Dim fName As String
Dim wb As Workbook
fName = Dir(FolderPath & "*.xls")
Do While fName <> ""
Set wb = Workbooks.Open(FolderPath & fName)
DeleteSheetsStartingWith wb, "code_D_"
RenameSheetsWithIncrement wb, "code_D_"
'wb.Close SaveChanges:=True
fName = Dir
Loop
End Sub
Sub RenameSheetsWithIncrement( _
ByVal wb As Workbook, _
ByVal BaseName As String, _
Optional ByVal FirstIndex As Long = 1)
If wb Is Nothing Then Exit Sub
Dim n As Long: n = FirstIndex
Dim sh As Object
For Each sh In wb.Sheets
sh.Name = BaseName & n
n = n + 1
Next sh
End Sub
Sub DeleteSheetsStartingWith( _
ByVal wb As Workbook, _
ByVal BaseString As String)
If wb Is Nothing Then Exit Sub
Dim sh As Object
Dim shNames() As String
Dim n As Long
Dim FoundVisible As Boolean
For Each sh In wb.Sheets
If InStr(1, sh.Name, BaseString, vbTextCompare) = 1 Then
If sh.Visible = xlSheetVeryHidden Then
sh.Visible = xlSheetVisible
End If
n = n + 1
ReDim Preserve shNames(1 To n)
shNames(n) = sh.Name
Else
If Not FoundVisible Then
If sh.Visible = xlSheetVisible Then
FoundVisible = True
End If
End If
End If
Next sh
If FoundVisible Then
If n > 0 Then
Application.DisplayAlerts = False
wb.Worksheets(shNames).Delete
Application.DisplayAlerts = True
'Else ' No sheets to delete.
End If
'Else ' No visible sheets would be left.
End If
End Sub
RenameSheetsWithIncrement
procedure is not used in the following procedure.Sub AllFiles()
Dim FolderPath As String
FolderPath = "C:\Users\user1\OneDrive\Desktop\something\macro_test\"
If Right(FolderPath, 1) <> "\" Then FolderPath = FolderPath & "\"
Dim fName As String
Dim wb As Workbook
Dim sh As Object
Dim n As Long
fName = Dir(FolderPath & "*.xls")
Do While fName <> ""
Set wb = Workbooks.Open(FolderPath & fName)
DeleteSheetsStartingWith wb, "code_D_"
n = 0
For Each sh In wb.Sheets
If InStr(1, sh.Name, "code_n_", vbTextCompare) = 1 Then
n = n + 1
sh.Name = "code_n_" & n
End If
Next sh
'wb.Close SaveChanges:=True
fName = Dir
Loop
End Sub
Upvotes: 1
Reputation: 1474
Consider the following code, where I'm trying to keep it as simple as possible:
Sub delRename()
Dim i As Long, Sheet As Variant
Application.DisplayAlerts = False
i = 1
For Each Sheet In ActiveWorkbook.Worksheets
If Left(Sheet.Name, 7) = "code_D_" Then
Sheet.Delete
ElseIf Left(Sheet.Name, 7) = "code_n_" then
Sheet.Name = "code_n_" & i
i = i + 1
End If
Next Sheet
End Sub
It goes through the sheets in the active book, and deletes all the sheets starting with the name "code_D_" by using the Left() function.
For the sheets named "code_n_", it changes the name to be in order.
Note that if the sheets named "code_n_X" are out of order, this might fail, as the name is already taken.
IF that is a concern, you'd have to add a check for this.
Upvotes: 1
Reputation: 14383
Your question has three significant parts. Each one is a worthy question by itself. All three together are a project and not a question to be answered here. The parts are (1) loop through all files in a folder and open all workbooks. (2) delete specified sheets and (3) rename the remaining sheets.
Part 1 you seem to have good control of. Part 3 isn't specified sufficiently to enable an answer and for part 2 a solution is offered below.
Private Sub DeleteSheets(Wb As Workbook)
' 270
Const FileName As String = "Code_D_"
Const FirstFile As Integer = 2
Const LastFile As Integer = 70
Dim Fn As String ' loop variable: file name
Dim i As Integer ' loop counter: file names
Application.DisplayAlerts = False
On Error Resume Next
For i = FirstFile To LastFile
Fn = FileName & i
Wb.Worksheets(Fn).Delete
If Wb.Worksheets.Count = 1 Then Exit For
Next i
Application.DisplayAlerts = False
End Sub
Your question isn't sufficiently specific but the core of this task is to create the sheet names. Your code specifies the core name to be "Code_D_" with a serial number following. If this number isn't consecutive from lowest to highest you might add exclusions using IF statements just before the Delete
instruction. If the pattern I chose isn't the one that's needed than another must be designed once the requirements are known.
You can call the above sub with a procedure like the one below.
Private Sub Test_DeleteSheets()
' 270
Dim Wb As Workbook
Set Wb = ThisWorkbook
DeleteSheets B
End Sub
In fact, your procedure that loops through all the workbooks produces a workbook object by the name of Wb
. So, you would only need to integrate the last line of this procedure into your existing one.
Witness that the scope of the first procedure above is Private
because it will only be called from another procedure in the same module. I made the calling procedure also Private
because it isn't intended to be called from any other location but the module it's in. Your looping procedure probably needs to be Public
(by default) but it must be in the same module as the Private
procedure it calls.
Upvotes: 1