Solved

Delete Current Sheet If No Dependents

Posted on 2015-02-22
9
44 Views
Last Modified: 2016-02-10
Hello Experts,

Frequently I need to delete sheets in a workbook and in order to avoid #REF errors, I normally do a quick FIND of the name of the current worksheet in the entire workbook, if the name is not found, in named ranges or hidden sheets, then it's safe to delete.

I would like a VBA code that will do the following:

1.

Find the name of the current sheet in the entire workbook, including in named ranges and in hidden sheets

2.

If name not found, then this means that no other sheets depend on it, so delete current sheet
Any help with this will be greatly appreciated.

Thanks,
0
Comment
Question by:SuraDalbin
  • 5
  • 3
9 Comments
 
LVL 7

Expert Comment

by:slubek
ID: 40625281
Try this:
Sub Search()
    Dim rng As Range
    Dim SheetName As String
    Dim found As Boolean
    
    Dim sh As Worksheet
    
    SheetName = ActiveSheet.Name
    found = False
        
    For Each sh In ThisWorkbook.Worksheets
        With sh.UsedRange
    
        Set rng = .Cells.Find(What:=SheetName, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
        
            If Not rng Is Nothing Then found = True
    
        End With
    Next
    
    If found Then
        MsgBox "Found"
    Else
        MsgBox "Not found"
        Worksheets(SheetName).Delete

    End If
   
End Sub

Open in new window

0
 
LVL 18

Accepted Solution

by:
Simon earned 500 total points
ID: 40625424
I don't think the above checks through the names collection. This version checks all sheets (hidden or visible) and the names collection. If it finds references to the sheet, it asks user if they want to see a list of the references in a new workbook. If no references it deletes the sheet.
Option Explicit

Sub CheckForReferencesToSheetBeforeDelete()
Dim shtName As String
Dim ws As Worksheet
Dim rngFound As Range
Dim shtNameFound As Boolean
Dim matches() As String
Dim wbName As Name
Dim rptBk As Workbook

    ReDim matches(0) 'initialise the array that will hold details of any matches for the worksheet name
    
    'Loop thru worksheets other than the active one to look for references in formulae
    shtName = ActiveSheet.Name
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> shtName Then
            Set rngFound = ws.Cells.Find(What:=shtName, LookIn:=xlFormulas, After:=ws.Cells(1, 1), LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If Not rngFound Is Nothing Then
                ReDim Preserve matches(UBound(matches) + 1)
                matches(UBound(matches)) = shtName & " found in worksheet formulas on sheet " & ws.Name & " at " & rngFound.Address
                shtNameFound = True
            End If
        End If
    Next
    
    'Loop thru names, looking for references to the sheet name
    For Each wbName In ActiveWorkbook.Names
        If wbName.Value Like "*" & shtName & "!*" Then
            ReDim Preserve matches(UBound(matches) + 1)
            matches(UBound(matches)) = shtName & " found in names collection (" & wbName.Name & ") " & wbName.Value
            shtNameFound = True
        End If
    Next wbName
        
    If shtNameFound Then
        If MsgBox("References to this worksheet (" & shtName & ") were found." & vbCrLf & "Do you want to list them?", vbYesNo) = vbYes Then
            Set rptBk = Application.Workbooks.Add
            rptBk.Worksheets(1).Range(Cells(1, 1), Cells(UBound(matches) + 1, 1)) = Application.Transpose(matches)
        End If
    Else
        'Application.DisplayAlerts = False
        Worksheets(shtName).Delete
        'Application.DisplayAlerts = True
    End If
End Sub

Open in new window

0
 

Author Closing Comment

by:SuraDalbin
ID: 40625893
SimonAdept, this is exactly what I needed, works like a charm.

Thank you very much.
0
 

Author Comment

by:SuraDalbin
ID: 40626250
SimonAdept,

I might have jumped the gun too quickly.  I tested the code by adding it to a regular module and attaching that to a button in the file.

The part I neglected to mention, and for this I apologize, is that I'd like to have this code work in my personal Add-Ins ribbon bar.

Thanks,
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 18

Expert Comment

by:Simon
ID: 40626356
Hi, what doesn't work when it's in your ribbon bar? It operates on ActiveWorkbook rather than the workbook that contains the code. It works for me when I run it from my Personal macro workbook.

If you can describe the error, I'll try to replicate it.
0
 

Author Comment

by:SuraDalbin
ID: 40626374
Hello Simon,

Yes, I figured out what the problem is.  I misspoke, the code works, but the problem that I discovered is that some of my named ranges have a single quote before the name of the sheet, for example in the Refers to: ='O4 Financials'!$B:$H compared to =Data!$B:$B (Code works properly on this sheet).

Would there be a way to change the line below, to check for both types of named ranges
If wbName.Value Like "*" & shtName & "!*" Then

Open in new window


I figured that this would be the only change, but obviously, if you see that it's something please let me know.
0
 

Author Comment

by:SuraDalbin
ID: 40626401
Hello Simon,

I might have answered my own question in my last reply, I changed the code to:

If wbName.Value Like "*'" & shtName & "'!*" Then

Open in new window


And this seems to work, but do you foresee any complications with this change?

Thanks for your help.
0
 
LVL 18

Expert Comment

by:Simon
ID: 40626984
Sorry, my code didn't cater for worksheets with spaces in the names. Unfortunately, your revision would not work with worksheets WITHOUT spaces in their names.

I originally wrote the code as
If wbName.Value Like "*" & shtName & "*" Then

Open in new window

and later added the ! to the pattern to avoid false positives

Probably better to replace that line with
If wbName.Value Like "*'" & shtName & "'!*" Or wbName.Value Like "*" & shtName & "!*" Then

Open in new window

To cater both for worksheet names with and without spaces while avoiding most false positive matches. There is still a slim chance of false positives if the sheet name is a substring of another sheet name (e.g. searching for 'sht1' when there is another sheet named 'wksht1'
0
 

Author Comment

by:SuraDalbin
ID: 40627441
Hello Simon,

Thank you very much for all your help, this is now working perfectly.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

920 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now