Macro only calls on the first Before Save, rather than before every save

[SkywardPalm]

I am trying to have this macro run before every save, to ensure that the two totals in question are matching. It only runs the first time I press ctrl+s

ThisWorkbook:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Call ExtendedTotalCheck

End Sub

DollarTotalCheck:

Sub ExtendedTotalCheck()
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet
    Dim extHeaderCell As Range, f As Range
    Dim masterTotal As Double

    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
  
    Set extHeaderCell = wsMaster.Range("1:1").Find("Extended")
    If Not extHeaderCell Is Nothing Then
            masterTotal = extHeaderCell.Offset(, 1).Value
            Set f = wsSUMMARY.Range("C228:D228").Find(masterTotal, , xlValues, xlWhole)
        If Not f Is Nothing Then
            Debug.Print "Extended Totals Match"
        Else
            MsgBox "Please check Extended Totals match!"
        End If
    End If
End Sub

 

[SkywardPalm]

Try:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet
    Dim extHeaderCell As Range, f As Range
    Dim masterTotal As Double
    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
    Set extHeaderCell = wsMaster.Range("1:1").Find("Extended")
    masterTotal = extHeaderCell.Offset(, 1).Value
    Set f = wsSUMMARY.Range("C228:D228").Find(masterTotal, , xlValues, xlWhole)
    If Not f Is Nothing Then
        MsgBox "Extended Totals Match"
    Else
        MsgBox "Please check Extended Totals match!"
        Cancel = True
    End If
End Sub

I've changed the debug.print to msgbox. It also cancels the "save" if "Please check Extended Totals match!" is displayed.

Thank you, I am getting the error message "Run-time error '91': Object variable or With block variable not set" on the line below. We know the variable exists because it was running fine the previous initial saves. I'm not sure what is causing this issue

    masterTotal = extHeaderCell.Offset(, 1).Value

 

[mumps]

I tested the macro using some dummy data and it worked properly. Could you upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[SkywardPalm]

I tested the macro using some dummy data and it worked properly. Could you upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Here is a link to the file de-sensitized. It will work the first time, but the extHeaderCell = Nothing on all the next saves, causing the error mentioned

 

[mumps]

Try:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet
    Dim extHeaderCell As Range, f As Range
    Dim masterTotal As Double
    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
    Set extHeaderCell = wsMaster.Rows(1).Find("Extended", LookIn:=xlFormulas, lookat:=xlWhole)
    masterTotal = extHeaderCell.Offset(, 1).Value
    Set f = wsSUMMARY.Range("C228:D228").Find(masterTotal, , xlValues, xlWhole)
    If Not f Is Nothing Then
        MsgBox "Extended Totals Match"
    Else
        MsgBox "Please check Extended Totals match!"
        Cancel = True
    End If
End Sub

 

[SkywardPalm]

Try:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet
    Dim extHeaderCell As Range, f As Range
    Dim masterTotal As Double
    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
    Set extHeaderCell = wsMaster.Rows(1).Find("Extended", LookIn:=xlFormulas, lookat:=xlWhole)
    masterTotal = extHeaderCell.Offset(, 1).Value
    Set f = wsSUMMARY.Range("C228:D228").Find(masterTotal, , xlValues, xlWhole)
    If Not f Is Nothing Then
        MsgBox "Extended Totals Match"
    Else
        MsgBox "Please check Extended Totals match!"
        Cancel = True
    End If
End Sub

Works like a charm! In the instance that the SUMMARY total is a formula "=ROUND(SUM(SUMMARY!$C$17:$C$226),2)" and the Master total is a different formula "=SUM(AA:AA)", even though they are $0 they do not equal and it will stop the save. Is there a way to compare the cell values as numbers (preferably two decimal .00)? Thanks for all of your help!

 

[mumps]

The formulae in C228 and D228 in SUMMARY are the same. What is the reason they are the same?

 

[SkywardPalm]

The formulae in C228 and D228 in SUMMARY are the same. What is the reason they are the same?

They should not be the same, I copied the formula from the current to the previous to provide an example of what could be there. the formula should represent the total value from the respective column that the totals are in. (The F column should read =ROUND(SUM(SUMMARY!$F$17:$F$226),2)* instead of C) Sorry for the confusion. The macro you provided works perfectly unless the totals equal 0, then the msgbox "Please check Extended Totals" appears even though both values = 0.

 

[mumps]

See if this works for you. I've based it on the value in C228.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet, extHeaderCell As Range, masterTotal As Double
    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
    Set extHeaderCell = wsMaster.Rows(1).Find("Extended", LookIn:=xlFormulas, lookat:=xlWhole)
    masterTotal = extHeaderCell.Offset(, 1).Value
    If masterTotal = 0 And wsSUMMARY.Range("C228") = 0 Then
        MsgBox "Extended Totals Match"
    Else
        If wsSUMMARY.Range("C228") = masterTotal Then
            MsgBox "Extended Totals Match"
        Else
            MsgBox "Please check Extended Totals match!"
            Cancel = True
        End If
    End If
End Sub

 

[SkywardPalm]

See if this works for you. I've based it on the value in C228.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.EnableEvents = True
    Dim wsMaster As Worksheet, wsSUMMARY As Worksheet, extHeaderCell As Range, masterTotal As Double
    Set wsMaster = ThisWorkbook.Sheets("Master")
    Set wsSUMMARY = ThisWorkbook.Sheets("SUMMARY")
    Set extHeaderCell = wsMaster.Rows(1).Find("Extended", LookIn:=xlFormulas, lookat:=xlWhole)
    masterTotal = extHeaderCell.Offset(, 1).Value
    If masterTotal = 0 And wsSUMMARY.Range("C228") = 0 Then
        MsgBox "Extended Totals Match"
    Else
        If wsSUMMARY.Range("C228") = masterTotal Then
            MsgBox "Extended Totals Match"
        Else
            MsgBox "Please check Extended Totals match!"
            Cancel = True
        End If
    End If
End Sub

Thank you! That seems to work perfectly. Sometimes there is an inserted column before 'C' on SUMMARY page for sub-section values, pushing the grand total to d228. Would that be as simple as changinging the range provided from c228 to c228:d228?

 

[mumps]

Replace

If wsSUMMARY.Range("C228") = masterTotal Then

with

If wsSUMMARY.Range("C228") = masterTotal Or wsSUMMARY.Range("D228") = masterTotal Then