[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Help with Macro to delete worksheet from book

Posted on 2013-01-10
8
Medium Priority
?
440 Views
Last Modified: 2013-01-10
I have the following macro below that I need adjusted to delete a worksheet in each workbook in the directory called '2013'


Sub Insert_Page()
Dim xPath     As String
Dim xFile     As String
Dim StartTime As Date
Dim EndTime   As Date
Dim xTemplate As Worksheet
Dim xOK       As Long
Dim xErrors   As Long

StartTime = Timer

Application.Calculation = xlCalculationManual
           
    Set xTemplate = Workbooks("2013_Template.xls").Sheets("New")
    xPath = "C:\TimeSheets\" 'N.B. don't forget closing "\".
   
    xFile = Dir(xPath + "*.xls*")
    While xFile <> ""
        On Error Resume Next
            Workbooks.Open Filename:=(xPath + xFile), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True
        On Error GoTo 0
        If ActiveWorkbook.Name = xFile Then
            If ActiveWorkbook.ReadOnly Then
                xErrors = xErrors + 1
                Debug.Print xErrors & " - " & xPath & xFile & " is read-only - file bypassed."
                Workbooks(xFile).Close SaveChanges:=False
            Else
                If Sheet_Exists("New", xFile) Then
                    ActiveWorkbook.Sheets("New").Name = "New_" & Format(Now(), "YYYYMMDDHHNNSS")
                End If
                xTemplate.Copy Before:=Workbooks(xFile).Sheets(1)
                Workbooks(xFile).Save
                Workbooks(xFile).Close SaveChanges:=False
                xOK = xOK + 1
            End If
        Else
            xErrors = xErrors + 1
            Debug.Print xErrors & " - " & xPath & xFile & " could not be opened - file bypassed."
        End If
        xFile = Dir()
    Wend

Application.Calculation = xlCalculationAutomatic

EndTime = Timer
MsgBox ("Insert_Page complete - " & xOK & " successfully processed, " & xErrors & " bypassed. (" & Format(EndTime - StartTime, "000") & " seconds)")

End Sub


Function Sheet_Exists(xSheet_Name As String, Optional xBook As String) As Boolean

If xBook = "" Then xBook = ActiveWorkbook.Name

Sheet_Exists = False

On Error Resume Next
    Sheet_Exists = (Workbooks(xBook).Sheets(xSheet_Name).Name = xSheet_Name)
On Error Resume Next

End Function


---

Thanks,

Brad
0
Comment
Question by:bradbritton
8 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 38762538
I read ur post again:
>>>
I have the following macro below that I need adjusted to delete a worksheet in each workbook in the directory called '2013'
>>>

Forget for a moment this code, and tell me what worksheet you need to delete ???
My understanding of this post is that:
you have a directory called '2013' (you don't say where and what is the path of this directory this directory contains several workbboks I suppose and you want to delete from each workbook 'a worksheet' you did not mention which !!!

I am sure my understanding is not correct, pls clarify so we can help you more.
gowflow
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38762866
Hi, bradbritton,

Please see attached. I wasn't clear what the sheet name should be so please change the two occurrences of "TOBEDELETED" as appropriate. (BTW, it might have been nice to do the delete before checking for the existence of a "New" sheet (so that it could have been deleted) - but that might have cause problems with files with a single sheet.)

The code is...
Option Explicit

Sub Insert_Page()
Dim xPath     As String
Dim xFile     As String
Dim StartTime As Date
Dim EndTime   As Date
Dim xTemplate As Worksheet
Dim xOK       As Long
Dim xErrors   As Long

StartTime = Timer

If Not Sheet_Exists("New", "2013_Template.xls") Then
    MsgBox ("2013_Template.xls must be open and contain a sheet name ""New"" - run cancelled.")
    Exit Sub
End If
Set xTemplate = Workbooks("2013_Template.xls").Sheets("New")
xPath = "C:\TimeSheets\" 'N.B. don't forget closing "\".

Application.Calculation = xlCalculationManual

    xFile = Dir(xPath + "*.xls*")
    While xFile <> ""
        On Error Resume Next
            Workbooks.Open Filename:=(xPath + xFile), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True
        On Error GoTo 0
        If ActiveWorkbook.Name = xFile Then
            With Workbooks(xFile)
                If .ReadOnly Then
                    xErrors = xErrors + 1
                    Debug.Print xErrors & " - " & xPath & xFile & " is read-only - file bypassed."
                    .Close SaveChanges:=False
                Else
                
                    If Sheet_Exists("New", xFile) Then
                        .Sheets("New").Name = "New_" & Format(Now(), "YYYYMMDDHHNNSS")
                    End If
                    xTemplate.Copy Before:=.Sheets(1)
                    
                    If Sheet_Exists("TOBEDELETED", xFile) Then
                        Application.DisplayAlerts = False
                            .Sheets("TOBEDELETED").Delete
                        Application.DisplayAlerts = True
                    End If
                    
                    .Save
                    .Close SaveChanges:=False
                    xOK = xOK + 1
                    
                End If
            End With
        Else
            xErrors = xErrors + 1
            Debug.Print xErrors & " - " & xPath & xFile & " could not be opened - file bypassed."
        End If
        xFile = Dir()
    Wend

Application.Calculation = xlCalculationAutomatic

EndTime = Timer
MsgBox ("Insert_Page complete - " & xOK & " successfully processed, " & xErrors & " bypassed. (" & Format(EndTime - StartTime, "000") & " seconds)")

End Sub


Function Sheet_Exists(xSheet_Name As String, Optional xBook As String) As Boolean

If xBook = "" Then xBook = ActiveWorkbook.Name

Sheet_Exists = False

On Error Resume Next
    Sheet_Exists = (Workbooks(xBook).Sheets(xSheet_Name).Name = xSheet_Name)
On Error Resume Next

End Function

Open in new window

Regards,
Brian.
Template-V3.xls
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:bradbritton
ID: 38763573
One thing I forgot about is that I needed to copy the Name and Start Date from the 2012 tab to the new tab. Could you add this in for me?

I have attached the an original version of the form and the template.

Thanks,
01-Sick-Holiday--Summary-Lisa-S.xls
2013-Template.xls
Template-V3.xls
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38763983
bradbritton,

I've been a bit cheeky and so the attached does what I think you want, rather than what you asked for.  :)

(1) There are two variable...
    xOld  = "2012"      'i.e. the name of the sheet to be deleted.
    xNew = "2013"     'i.e. the name of the sheet to be copied in.
(2) The code assumes that the sheet to be copied (xNew) is in the file containing the macro. (So you don't have to continually rename the file in the macro.)
(3) The sheet to be added from the Template file must be named xNew.
(4) For each of the input files...
 - If it already contains a sheet named xNew then it's renamed.
 - The sheet named xNew is copied in from the Template file.
 - If there is a sheet named xOld then the two fields are copied to the xNew sheet and the xOld sheet is deleted.

The code is...
Option Explicit

Sub Insert_Page()
Dim xPath     As String
Dim xFile     As String
Dim xName     As Variant
Dim xDate     As Variant
Dim StartTime As Date
Dim EndTime   As Date
Dim xTemplate As Worksheet
Dim xOK       As Long
Dim xErrors   As Long
Dim xOld      As String
Dim xNew      As String

StartTime = Timer

xOld = "2012"
xNew = "2013"
If Not Sheet_Exists(xNew, ThisWorkbook.Name) Then
    MsgBox ("This file must contain a sheet name ""New"" - run cancelled.")
    Exit Sub
End If

Set xTemplate = ThisWorkbook.Sheets(xNew)
xPath = "C:\TimeSheets\" 'N.B. don't forget closing "\".

Application.Calculation = xlCalculationManual

    xFile = Dir(xPath + "*.xls*")
    While xFile <> ""
        On Error Resume Next
            Workbooks.Open Filename:=(xPath + xFile), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True
        On Error GoTo 0
        If ActiveWorkbook.Name = xFile Then
            With Workbooks(xFile)
                If .ReadOnly Then
                    xErrors = xErrors + 1
                    Debug.Print xErrors & " - " & xPath & xFile & " is read-only - file bypassed."
                    .Close SaveChanges:=False
                Else
                
                    If Sheet_Exists(xNew, xFile) Then
                        .Sheets(xNew).Name = Mid(Format(Now(), "YYYYMMDDHHNNSS") & "_" & xNew, 1, 31)
                    End If
                
                    xTemplate.Copy Before:=.Sheets(1)
                                        
                    If Sheet_Exists(xOld, xFile) Then
                    
                        xName = .Sheets(xOld).Range("B1")
                        xDate = .Sheets(xOld).Range("L1")
                        
                        Application.DisplayAlerts = False
                            .Sheets(xOld).Delete
                        Application.DisplayAlerts = True
                    
                        .Sheets(xNew).Range("B1") = xName
                        .Sheets(xNew).Range("L1") = xDate

                    End If
                    
                    .Save
                    .Close SaveChanges:=False
                    xOK = xOK + 1
                    
                End If
            End With
        Else
            xErrors = xErrors + 1
            Debug.Print xErrors & " - " & xPath & xFile & " could not be opened - file bypassed."
        End If
        xFile = Dir()
    Wend

Application.Calculation = xlCalculationAutomatic

EndTime = Timer
MsgBox ("Insert_Page complete - " & xOK & " successfully processed, " & xErrors & " bypassed. (" & Format(EndTime - StartTime, "000") & " seconds)")

End Sub


Function Sheet_Exists(xSheet_Name As String, Optional xBook As String) As Boolean

If xBook = "" Then xBook = ActiveWorkbook.Name

Sheet_Exists = False

On Error Resume Next
    Sheet_Exists = (Workbooks(xBook).Sheets(xSheet_Name).Name = xSheet_Name)
On Error Resume Next

End Function

Open in new window

Regards,
Brian.
Template-V4.xls
0
 

Author Comment

by:bradbritton
ID: 38764293
thanks for coding that Brian! Close, but no cigar!

I have attached a copy of what I want the finished form to look like after the template has been added.

Thanks!

Brad
01-Sick-Holiday--Summary-Lisa-S-.xls
0
 
LVL 26

Accepted Solution

by:
redmondb earned 2000 total points
ID: 38764397
bradbritton,

Close, but no cigar!
So the word "delete" in the question's title translates as ... "not delete"?!   :)

Is it deliberate that the 2012 and 2013 sheets have the start date in different columns?

Please see the attached. The code is...
Option Explicit

Sub Insert_Page()
Dim xPath     As String
Dim xFile     As String
Dim xName     As Variant
Dim xDate     As Variant
Dim StartTime As Date
Dim EndTime   As Date
Dim xTemplate As Worksheet
Dim xOK       As Long
Dim xErrors   As Long
Dim xOld      As String
Dim xNew      As String

StartTime = Timer

xOld = "2012"
xNew = "2013"
If Not Sheet_Exists(xNew, ThisWorkbook.Name) Then
    MsgBox ("This file must contain a sheet name ""New"" - run cancelled.")
    Exit Sub
End If

Set xTemplate = ThisWorkbook.Sheets(xNew)
xPath = "C:\TimeSheets\" 'N.B. don't forget closing "\".

Application.Calculation = xlCalculationManual

    xFile = Dir(xPath + "*.xls*")
    While xFile <> ""
        On Error Resume Next
            Workbooks.Open Filename:=(xPath + xFile), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True
        On Error GoTo 0
        If ActiveWorkbook.Name = xFile Then
            With Workbooks(xFile)
                If .ReadOnly Then
                    xErrors = xErrors + 1
                    Debug.Print xErrors & " - " & xPath & xFile & " is read-only - file bypassed."
                    .Close SaveChanges:=False
                Else
                
                    If Sheet_Exists(xNew, xFile) Then
                        .Sheets(xNew).Name = Mid(Format(Now(), "YYYYMMDDHHNNSS") & "_" & xNew, 1, 31)
                    End If
                
                    xTemplate.Copy Before:=.Sheets(1)
                                        
                    If Sheet_Exists(xOld, xFile) Then
                    
                        xName = .Sheets(xOld).Range("B1")
                        xDate = .Sheets(xOld).Range("L1")
                    
                        .Sheets(xNew).Range("B1") = xName
                        .Sheets(xNew).Range("J1") = xDate

                    End If
                    
                    .Save
                    .Close SaveChanges:=False
                    xOK = xOK + 1
                    
                End If
            End With
        Else
            xErrors = xErrors + 1
            Debug.Print xErrors & " - " & xPath & xFile & " could not be opened - file bypassed."
        End If
        xFile = Dir()
    Wend

Application.Calculation = xlCalculationAutomatic

EndTime = Timer
MsgBox ("Insert_Page complete - " & xOK & " successfully processed, " & xErrors & " bypassed. (" & Format(EndTime - StartTime, "000") & " seconds)")

End Sub


Function Sheet_Exists(xSheet_Name As String, Optional xBook As String) As Boolean

If xBook = "" Then xBook = ActiveWorkbook.Name

Sheet_Exists = False

On Error Resume Next
    Sheet_Exists = (Workbooks(xBook).Sheets(xSheet_Name).Name = xSheet_Name)
On Error Resume Next

End Functio

Open in new window

Regards,
Brian.
Template-V5.xls
0
 
LVL 26

Expert Comment

by:redmondb
ID: 38765314
Thanks, Brad!
0

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

In threads here at EE, each comment has a unique Identifier (ID). It is easy to get the full path for an ID via the right-click context menu. However, we often want to post a short link within a thread rather than the full link. This article shows a…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Suggested Courses
Course of the Month18 days, 19 hours left to enroll

834 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