Solved

Delete Current Sheet If No Dependents

Posted on 2015-02-22
9
46 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
ScreenConnect 6.0 Free Trial

Explore all the enhancements in one game-changing release, ScreenConnect 6.0, based on partner feedback. New features include a redesigned UI, app configurations and chat acknowledgement to improve customer engagement!

 

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
 
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 AD Toolbox Looking More Like a Toybox?

Managing Active Directory can get complicated.  Often, the native tools for managing AD are just not up to the task.  The largest Active Directory installations in the world have relied on one tool to manage their day-to-day administration tasks: Hyena. Start your trial today.

Question has a verified solution.

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

How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

810 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