Help with VBA code in Excel for automation 1

[tony9bb]

I'm a novice (at best) in writing VBA code and I'm trying to "automate" a workbook for the "boss".

What happens is I have a workbook with a sheet for every month of the year that contains columns for ID, Name, Amnt, Prev Balance, Fees, Amnt Paid, Current Balnce. The ID, Name and Amnt come from an access database. As days go by paid amnts are entered and balances are calculated.

So I created this code to:
1. Copy the "values" of the cells into a new sheet
2. Create the new month sheet
3. Carry over the balances.

These sheets are created from a template (that is hidden) by a button on the sheet.

The previous balances are retreived from the previous month sheet with a formula link. And the current balance is a simple formula.

I have written this code that works, but it has "holes" in it. That is, if the user tries to create the sheet more than once within a month, it will error out. I have tried to catch this through code but I'm not there yet.

Here's what I have so far. . . most of which I received from this forum. . . Thanks all.

Option Explicit

Private Sub DoIt_Click()

Dim Sh, aWorkSheet, ws As Worksheet
Dim Shbak, wsName, strTextFile, strDate, wsNamecpy, txtDate, response, txtrandom, new_sheetname As String
Dim NewMnth, dtmDate As Date
Dim LastDayPrevMonth As Date
Dim tstDate As Integer
Dim i, j, k, w As Integer

'Test to see if it's the Last week of the month
    tstDate = Format(Now, "dd")
If tstDate < 26 Then
    response = MsgBox("Are You Sure You Want to Create the Next Month Sheet?", vbOKCancel + vbQuestion, "New Month Creation")
Else
    End If
    If response = 2 Then
        'Exit Subroutine
        GoTo tstStop
    Else
    
'Set the variable for sheet names
    wsName = ActiveSheet.Name
    wsNamecpy = wsName & " (2)"
    
'Copy the worksheet and "values" of cells -- turn off autofilter
Worksheets(wsName).Copy Before:=Worksheets(wsName)
Worksheets(wsName).Activate
    Range("a1").AutoFilter
                ActiveSheet.Range("a2:K66").Select
                ActiveSheet.Range("a3:K66").Select
                Application.Selection.Copy
            Worksheets(wsNamecpy).Activate
                ActiveSheet.Range("A3:k66").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                ActiveSheet.Range("A2").Select
                    
'Rename the backup worksheet
    Worksheets(wsName).Activate
    Range("A2:k66").AutoFilter
    Set Sh = Worksheets(wsName & " (2)")
    Sh.Name = wsName & "BAK"
    
'Save backup worksheet name for later
    Shbak = wsName & "BAK"
    
'Create New Sheet from RRTemplate
    LastDayPrevMonth = DateSerial(Year(Date), Month(Date), 0)
    dtmDate = LastDayPrevMonth
    strDate = Format(dtmDate, "yyyy")
    txtDate = Format(dtmDate + 1, "mmmm")
    strDate = Right$(strDate, 2)
    i = Format(Date + 1, "MM")
    Worksheets("RRTemplate").Copy After:=Worksheets(wsName)
    Worksheets(wsName).Activate
Set Sh = Worksheets("RRTemplate (2)")
new_sheetname = Format(dtmDate + 1, "MMM") & strDate
For w = 1 To ActiveWorkbook.Worksheets.Count
    If Worksheets(w).Name = new_sheetname Then
        response = MsgBox("There Is Already A " & new_sheetname & "Do you Want to Continue?", vbOKCancel + vbQuestion, "New Month Creation")
           If response = 2 Then
           GoTo tstStop
           Else
           End If
    txtrandom = Str$(Int(6 * Rnd) + 1)
    Sh.Name = Format(dtmDate + 1, "MMM") & strDate & txtrandom
    Else
    'do nothing
    End If
Next
 
'%Create New Sheet from RRTemplate
    If Sh.Name = "RRTemplate (2)" Then
    Sh.Name = Format(dtmDate + 1, "MMM") & strDate
Else
End If
    Worksheets(Sh.Name).Activate

'Put Month text in cell D1
    ActiveSheet.Range("d1") = txtDate
    
'Turn autofilter on in new sheet and add button
    ActiveSheet.Range("a2:k66").AutoFilter
    Sheets(Sh.Name).Visible = True
    '******** Because RRTemplate is hidden ********
'Insert formula for Previous balance
    Worksheets(Sh.Name).Activate
    ActiveSheet.Range("D3").Select
    ActiveCell.FormulaR1C1 = "=SUM('" & Shbak & "'!RC[7])"
    Worksheets(Sh.Name).Range("d3:d66").FillDown
GoTo Endit

tstStop:
    On Error Resume Next
    Application.DisplayAlerts = False
        Worksheets("RRTemplate (2)").Delete
    Application.DisplayAlerts = True
Endit:
End If
End Sub

Can someone point me in the right direction to make this as foolproof (idiotproof) as possible.

I think I'm in that position of "when you're in a swamp full of alligators, it's hard to remember your objective was to drain the swamp".


Oh, and my "boss" is my wife. . . ie the alligators

 

[GVF]

When you make assumptions, you will get errors. You are assuming that the sheet you copy will have a certain name and when VB can't rename the sheet, you generate an error. You should always grab the sheet name immediately after you copy a sheet so you have a start point in your process. If you programatically try to change a sheet name and there is already a sheet with the same name in the file, you will generate an error that must be trapped. I have played with your code a bit and it came out looking like this...

Option Explicit
Private Shbak, wsName, wsNamecpy, NewRRSht As String

Private Sub DoIt_Click()
Dim Response
On Error Resume Next
If Day(Now()) < 26 Then
Response = MsgBox("Are You Sure You Want to Create the Next Month Sheet?", vbYesNo + vbQuestion, "New Month Creation")
If Response = vbNo Then Exit Sub
End If
wsName = ActiveSheet.Name
Worksheets(wsName).Copy Before:=Worksheets(wsName)
wsNamecpy = ActiveSheet.Name
Err.Clear
ActiveSheet.Name = wsName & " BAK"
If Err <> 0 Then
MsgBox "You must manually rename the backup sheet.", vbOKOnly + vbInformation, "New Month Creation"
Response = Application.Dialogs(xlDialogWorkbookName).Show(ActiveSheet.Name, wsName & " BAK")
If Response = False Then
Application.DisplayAlerts = False
Sheets(wsNamecpy).Delete
Sheets(wsName).Activate
Exit Sub
End If
End If
Shbak = ActiveSheet.Name
Worksheets(wsName).Activate
Range("a1").AutoFilter
ActiveSheet.Range("a2:K66").Select
ActiveSheet.Range("a3:K66").Select
Application.Selection.Copy
Cells(1, 2).Select
Worksheets(Shbak).Activate
ActiveSheet.Range("A3:k66").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Range("A2").Select
Application.ScreenUpdating = False
Sheets("RRTemplate").Visible = True
Sheets("RRTemplate").Copy After:=Worksheets(wsName)
NewRRSht = ActiveSheet.Name
Sheets("RRTemplate").Visible = False
Err.Clear
Sheets(NewRRSht).Name = Format(Date + 1, "MMM") & Right(Year(Now()), 2)
If Err <> 0 Then
MsgBox "You must manually rename the new RR sheet.", vbOKOnly + vbInformation, "New Month Creation"
Response = Application.Dialogs(xlDialogWorkbookName).Show(NewRRSht, Format(Date + 1, "MMM") & Right(Year(Now()), 2))
If Response = False Then
Application.DisplayAlerts = False
Sheets(NewRRSht).Delete
Application.DisplayAlerts = True
Sheets(wsName).Activate
Exit Sub
End If
End If
NewRRSht = ActiveSheet.Name
ActiveSheet.Range("d1") = Format(DateSerial(Year(Date), Month(Date), 0) + 1, "mmmm")
ActiveSheet.Range("a2:k66").AutoFilter
ActiveSheet.Range("D3").Select
ActiveCell.FormulaR1C1 = "=SUM('" & Shbak & "'!RC[7])"
Worksheets(NewRRSht).Range("d3:d66").FillDown
Cells(1, 2).Select
End Sub

Good Luck

Greg

 

[tony9bb]

Thanks GVF for your response.

When I copied your code into the template sheet and run it. It errors with duplicate name, if I try to create the sheet twice.

    Sheets(NewRRSht).Name = Format(Date + 1, "MMM") & Right(Year(Now()), 2)

Should I just put in an "exists" if statement and follow it with your code to manually name the file prior to executing the renaming of RRTemplate (2)??

Just FYI I'm using Office 2003.

Thanks again for your help with this.

Tony

 

[GVF]

Yes, an error will occur if you try to run the macro a second time. The error should be noted by the macro and the xldialogworkbookname dialog should appear to enable the user to pick a different name for the sheet. The way it is written, if the user cancels the workbookname dialog the new RRTemplate sheet is deleted from the file and the macro ends.

If you are using "On Error Resume Next" You should not encounter a break in the macro.

 

[tony9bb]

The On Error Resume Next is what I thought would prevent the error, but it doesn't. I get a runtime error, and it says "cannot rename a sheet as another sheet. . . " instead of the dialog box.

It's like the "resume next is not working (???)

I'm confused. . .

I like the way your re-code works better than mine. If I can just get by this one problem.
Thanks for your help.

 

[tony9bb]

I got it!!!. . . I had the options set to stop on all errors. I changed it to Stop on unhandled errors and it WORKS!!!

Grreat job GVF.

Thanks for your help.

Tony

 

[GVF]

My pleasure Tony.

Remember to always consider the bad things that can happen (what-ifs) and then try to trap them.

Greg