BossHard
BossHard

Reputation: 39

Excel VBA - how to rename sheets based on missing sheets

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

Answers (3)

VBasic2008
VBasic2008

Reputation: 54807

Delete and Rename Worksheets

  • You only run your modified 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

EDIT

  • The 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

Christofer Weber
Christofer Weber

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

Variatus
Variatus

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

Related Questions