Solved

Help with Macro to delete worksheet from book

Posted on 2013-01-10
8
402 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
DevOps Toolchain Recommendations

Read this Gartner Research Note and discover how your IT organization can automate and optimize DevOps processes using a toolchain architecture.

 

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

Master Your Team's Linux and Cloud Stack

Come see why top tech companies like Mailchimp and Media Temple use Linux Academy to build their employee training programs.

Question has a verified solution.

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

Suggested Solutions

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
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…

815 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

11 Experts available now in Live!

Get 1:1 Help Now