Solved

Help with Macro to delete worksheet from book

Posted on 2013-01-10
8
400 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 39

Expert Comment

by:Pratima Pharande
ID: 38762533
0
 
LVL 29

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
 

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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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 500 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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

This article will show, step by step, how to integrate R code into a R Sweave document
Active Directory replication delay is the cause to many problems.  Here is a super easy script to force Active Directory replication to all sites with by using an elevated PowerShell command prompt, and a tool to verify your changes.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

757 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

19 Experts available now in Live!

Get 1:1 Help Now