How to flag or delete sheets not in a list with a

2019-08-17 07:11发布

The following is a work in progress of some code to do the following:

  • colour sheet tabs if they are not in a reference list
  • Notify user of the list of sheets were not in the reference list
  • Delete the sheets not in the reference list depending on user input

Sub Audit_Estimate_sheets()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim ws_List As String
    Dim Delete_Orphans As Integer
    Dim Item_List_Sheet As Worksheet
    Dim Item_List_First_Row As Long
    Dim Item_List_Max_Row As Long

    Set Item_List_Sheet = Sheets(2)

    Item_List_First_Row = 14
    Item_List_Max_Row = Item_List_First_Row + Application.WorksheetFunction.Max(Item_List_Sheet.Range("B:B")) - 1

    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        If IsError(Application.Match(ws.Name, Item_List_Sheet.Range("C" & Item_List_First_Row & ":C" & Item_List_Max_Row), 0)) And ws.Index > 2 Then
            'Colour Tab'
            With ws.Tab
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0
            End With
            'Add name to list
            If ws_List = "" Then
                ws_List = ws.Name
            Else
                ws_List = ws_List & ", " & ws.Name
            End If
        End If
    Next ws

    'display list
    Delete_Orphans = MsgBox("The following estimate sheets were not part of the item list and are currently orphaned:  " & vbLf & vbLf & ws_List & vbLf & vbLf & "Would you like to delete them?", vbYesNo + vbQuestion, "Delete Orphaned Estimates")

    If Delete_Orphans = vbYes Then
        'loop through sheets again and delete
    End If

End Sub

In my workbook there are a few sheets that are not in the reference list but I do not want them deleted either. Even my approach of making sure I am beyond sheet(2) is not necessarily a good approach if my understanding that if a user drags a tab out of order its index number can change. My simple approach which winds up with a lot of text is a series nested if statements

IF ws.name <> exception1 Then
    IF ws.name <> exception2 Then
        IF ws.name <> exception3 Then
            ws.delete
        End If
    End If
End If

Is there a better approach?

标签: excel vba
1条回答
萌系小妹纸
2楼-- · 2019-08-17 07:40

I think Select Case will help:

Select Case ws.Name
    Case "exception1", "exception2", "exception3" 'ignore
    Case Else
       ws.Delete 'or whatever other code you want here
End Case

If you're exception list becomes long, you can also write a function to test the name against a list of defined names as well. That will be easier to manage.

One function example would like this, in short:

If Not exception(ws.Name) Then
    ws.Delete 'or whatever other code is needed
End If

Function exception(theSheet as String) as Boolean
'boolean is false by default, so only changing to true if it finds sheet is in exception list

    Dim exceptions(2) as String
    exceptions(0) = "exception1"
    exceptions(1) = "exception2"
    exceptions(2) = "exception3"

    Dim looper as Integer
    For looper = lbound(exceptions) to ubound(exceptions)
        If theSheet = exceptions(looper) Then
            exception = True
            Exit For
        End If
    Next

End Function
查看更多
登录 后发表回答