Solved

Help with Macro to delete worksheet from book

Posted on 2013-01-10
8
408 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Suggested Solutions

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
A quick Powershell script I wrote to find old program installations and check versions of a specific file across the network.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

685 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