Solved

Call Macros on Close

Posted on 2011-09-03
7
196 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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

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 80

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

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!

Join & Write a Comment

Introduction This Article is a follow-up to my Mappit! Addin Article (http://www.experts-exchange.com/A_2613.html), it was inspired by an email posting I made to EUSPRIG (http://www.eusprig.org/index.htm), I will briefly cover: 1) An overvie…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

762 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

24 Experts available now in Live!

Get 1:1 Help Now