Solved

Call Macros on Close

Posted on 2011-09-03
7
201 Views
Last Modified: 2012-05-12
I have the following two macros that I need to trigger on SAVE. I tried putting them both like

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call CheckData
Call ClearContents
End Sub

But, it does one but not the other.
Sub CheckData()
Dim i As Long
Dim blFailed As Boolean
Dim col As Long
col = 19  '34 to 40 are good
col2 = 3

ActiveSheet.Activate
ActiveSheet.Unprotect

For i = 12 To 50
    With ActiveSheet.Cells(i, "F")
        If .Value = "MAX" Then
           If .Offset(0, -1).Value = "" Then
                 blFailed = True
                 .Offset(0, -1).Interior.ColorIndex = col2
             Else
                 .Offset(0, -1).Interior.ColorIndex = col
             End If
             
             If .Offset(0, -2).Value = "" Then
                  blFailed = True
                 .Offset(0, -2).Interior.ColorIndex = col2
             Else
                 .Offset(0, -2).Interior.ColorIndex = col
             End If
             If .Offset(0, -4).Value = "" Then
                 blFailed = True
                 .Offset(0, -4).Interior.ColorIndex = col2
             Else
                 .Offset(0, -4).Interior.ColorIndex = col
             End If
             If .Offset(0, 3).Value = "" Then
                 blFailed = True
                 .Offset(0, 3).Interior.ColorIndex = col2
             Else
                 .Offset(0, 3).Interior.ColorIndex = col
             End If
             If .Offset(0, 19).Value = "" Then
                 blFailed = True
                 .Offset(0, 19).Interior.ColorIndex = col2
            Else
                 .Offset(0, 19).Interior.ColorIndex = col
             End If
        End If
    End With
Next i
Range("A12").Select

    If blFailed Then
        MsgBox "Cannot SAVE file! All Cells Colored Red need to be filled in", vbExclamation, "Save Cancelled"
        Cancel = True
    End If


ActiveSheet.Protect
End Sub
Sub ClearContents()
Dim i As Long
Dim wks As Worksheet

    For Each wks In ActiveWorkbook.Worksheets
        
        wks.Activate
        
        On Error Resume Next
        wks.Unprotect
        'On Error GoTo 0
        
        For i = 6 To 44
        
            If InStr(LCase(wks.Name), "wire") > 0 Then
                If Range("B" & i).Value = " " Then
                    wks.Range("i" & i & ":k" & i).Cells.SpecialCells(xlTextValues).ClearContents
                    
                End If
            End If
        
        Next i
        
        wks.Range("A6").Select
        'On Error Resume Next
        wks.Protect
        'On Error GoTo 0
        
    Next wks
    Cancel = True
        
End Sub

Open in new window

0
Comment
Question by:mato01
7 Comments
 
LVL 2

Expert Comment

by:jnfsmile
ID: 36478772
Both seem to run fine for me. Have you tried debugging?
0
 
LVL 2

Expert Comment

by:junkymail1
ID: 36478780
Did you try just putting the call into a separate sub?  Something like:

Sub  DoCloseStuff()
Call CheckData
Call ClearContents
end Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Call DoCloseStuff
End Sub
0
 

Author Comment

by:mato01
ID: 36478939
Hi Experts,

I placed the following code.  The BeforeSave is working.  But the BeforeCLose does not.  It allows the workbook to close, and is ignoring the script.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call DoCloseStuff
End Sub
___________

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DoCloseStuff
End Sub
___________

Sub DoCloseStuff()
Call CheckData
Call ClearContents
End Sub
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

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.

 

Author Comment

by:mato01
ID: 36479083
Hi Experts,

I'm attaching the file for reference.  You should not be able to save or close the workbook unless all the highlighted (RED) cells on the worksheet (TEST) are filled in. It seems to work for the save, but on the close it will eventually let you save file without filling in the RED on the (TEST) worksheet.
TestMacros-Check.xls
0
 
LVL 2

Expert Comment

by:junkymail1
ID: 36479300
I tried your worksheet and the DoCloseStuff() seems to be called when I do the close actions.  I put a breakpoint in the DoCloseStuff() and the breakpoint is hit when I do a save, saveas, or a close.  Are you sure that you have all of the macros enabled?  Mine seems to work, can you tell me the action you preform when the DoCloseStuff() is not called?  It does seem like BeforeClose() or either the BeforeSave() is called, but not both.  I think it is called based on the action, close or save.  That was why I suggested putting the call to the DoCloseStuff() from both.  Please try with a breakpoint in the DoCloseStuff() and check the call stack to see which is called, also make sure that full macros are enabled.  
0
 
LVL 81

Accepted Solution

by:
byundt earned 250 total points
ID: 36479336
mato01,
Although you are setting Cancel = True in your supporting subs, you never return that value back to the Workbook_BeforeSave or Workbooki_BeforeClose subs. I modified your code to do that.

You also don't have a valid test for any problems in your ClearContents sub. It would appear from your sample workbook that you intend such a test--because you try displaying an error message and try to set Cancel = True.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call DoCloseStuff(Cancel)
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DoCloseStuff(Cancel)
End Sub

Sub DoCloseStuff(Cancel As Boolean)
Call CheckData(Cancel)
If Cancel = False Then Call ClearContents(Cancel)
End Sub

Sub ClearContents(Cancel As Boolean)
Dim i As Long
Dim bTest As Boolean
Dim wks As Worksheet

For Each wks In ActiveWorkbook.Worksheets
    bTest = False
    If InStr(LCase(wks.Name), "wire") > 0 Then
        wks.Activate
        
        On Error Resume Next
        wks.Unprotect
        'On Error GoTo 0
        
        For i = 6 To 44
        
            If InStr(LCase(wks.Name), "wire") > 0 Then
                If Range("B" & i).Value = " " Then
                    wks.Range("i" & i & ":k" & i).Cells.SpecialCells(xlTextValues).ClearContents
                    
                End If
            End If
            If False Then bTest = True      'You need to have a valid test here
        Next i
        
        wks.Range("A6").Select
        'On Error Resume Next
        wks.Protect
        'On Error GoTo 0
        '***I don't know what you are checking, but you need a way to bypass this statement if everything is OK
        If bTest Then
            MsgBox "Cannot SAVE or CLOSE file! All Cells Colored Red need to be filled in", vbExclamation, "Close Cancelled"
            Cancel = True
        End If
    End If
Next wks
        
End Sub

Sub CheckData(Cancel As Boolean)
Dim i As Long
Dim blFailed As Boolean
Dim col As Long
col = 19
col2 = 3

ActiveSheet.Activate
ActiveSheet.Unprotect

For i = 12 To 50
    With ActiveSheet.Cells(i, "F")
        If .Value = "MAX" Then
           If .Offset(0, -1).Value = "" Then
                 blFailed = True
                 .Offset(0, -1).Interior.ColorIndex = col2
             Else
                 .Offset(0, -1).Interior.ColorIndex = col
             End If
             
             If .Offset(0, -2).Value = "" Then
                  blFailed = True
                 .Offset(0, -2).Interior.ColorIndex = col2
             Else
                 .Offset(0, -2).Interior.ColorIndex = col
             End If
             If .Offset(0, -4).Value = "" Then
                 blFailed = True
                 .Offset(0, -4).Interior.ColorIndex = col2
             Else
                 .Offset(0, -4).Interior.ColorIndex = col
             End If
             If .Offset(0, 3).Value = "" Then
                 blFailed = True
                 .Offset(0, 3).Interior.ColorIndex = col2
             Else
                 .Offset(0, 3).Interior.ColorIndex = col
             End If
             If .Offset(0, 19).Value = "" Then
                 blFailed = True
                 .Offset(0, 19).Interior.ColorIndex = col2
            Else
                 .Offset(0, 19).Interior.ColorIndex = col
             End If
        End If
    End With
Next i

    If blFailed Then
        MsgBox "Cannot SAVE or CLOSE file! All Cells Colored Red need to be filled in", vbExclamation, "Save Cancelled"
        Cancel = True
    End If

ActiveSheet.Protect
Range("A12").Select
End Sub
Sub CopyBrandConstraint()

Dim vSht, i As Long

vSht = Array("TEST")

For i = LBound(vSht) To UBound(vSht)
    Sheets("Acadia").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = vSht(i)
Next i

End Sub
Sub CopyBrandConstraintWire()

Dim vSht, i As Long

vSht = Array("TEST Wire")

For i = LBound(vSht) To UBound(vSht)
    Sheets("Acadia Wire").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = vSht(i)
Next i

End Sub
Sub CheckDataClose()
Dim i As Long
Dim blFailed As Boolean
Dim col As Long
col = 19
col2 = 3

ActiveSheet.Activate
ActiveSheet.Unprotect

For i = 12 To 50
    With ActiveSheet.Cells(i, "F")
        If .Value = "MAX" Then
           If .Offset(0, -1).Value = "" Then
                 blFailed = True
                 .Offset(0, -1).Interior.ColorIndex = col2
             Else
                 .Offset(0, -1).Interior.ColorIndex = col
             End If
             
             If .Offset(0, -2).Value = "" Then
                  blFailed = True
                 .Offset(0, -2).Interior.ColorIndex = col2
             Else
                 .Offset(0, -2).Interior.ColorIndex = col
             End If
             If .Offset(0, -4).Value = "" Then
                 blFailed = True
                 .Offset(0, -4).Interior.ColorIndex = col2
             Else
                 .Offset(0, -4).Interior.ColorIndex = col
             End If
             If .Offset(0, 3).Value = "" Then
                 blFailed = True
                 .Offset(0, 3).Interior.ColorIndex = col2
             Else
                 .Offset(0, 3).Interior.ColorIndex = col
             End If
             If .Offset(0, 19).Value = "" Then
                 blFailed = True
                 .Offset(0, 19).Interior.ColorIndex = col2
            Else
                 .Offset(0, 19).Interior.ColorIndex = col
             End If
        End If
    End With
Next i

    If blFailed Then
        MsgBox "Cannot SAVE or CLOSE file! All Cells Colored Red need to be filled in", vbExclamation, "Save Cancelled"
        Cancel = True
    End If

ActiveSheet.Protect
Range("A12").Select
End Sub

Open in new window


Brad
0
 

Author Closing Comment

by:mato01
ID: 36480987
Thanks.  I'm almost there.
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say 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

Suggested Solutions

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

856 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