Solved

Call Macros on Close

Posted on 2011-09-03
7
204 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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
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!

 

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

Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

Question has a verified solution.

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

How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

738 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