[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 212
  • Last Modified:

Call Macros on Close

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
mato01
Asked:
mato01
1 Solution
 
jnfsmileWeb DeveloperCommented:
Both seem to run fine for me. Have you tried debugging?
0
 
junkymail1Commented:
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
 
mato01Author Commented:
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
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
mato01Author Commented:
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
 
junkymail1Commented:
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
 
byundtCommented:
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
 
mato01Author Commented:
Thanks.  I'm almost there.
0

Featured Post

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.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now