Prevent user from closing excel unless two cells are equal

[Niven]

Hi,

I am creating a timesheet for users to enter their daily working hours as well as an allocation of their total hours worked. The allocation is very important as they work in different projects.

Is there a way I can prevent the workbook from closing and an error message appearing to let them know that their total hours need to equal the hours allocated?

Thanks.
Niven

 

[Jon von der Heyden]

Hi Niven and welcome to the forum.

Try this code in your workbook. The code belongs in the ThisWorkbook module of your project. Hit ALT+F11 to open the VBE and then locate ThisWorkbook in your project. Double click it to open the code pane and paste it in there.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim blnCancel As Boolean
    Dim rngCell1 As Excel.Range, rngCell2 As Excel.Range


    With Sheet1 '<- change to reference the required sheet
        Set rngCell1 = .Range("A1") '<- change to reference the required cell
        Set rngCell2 = .Range("A2") '<- change to reference the required cell
    End With


    blnCancel = rngCell1.Value2 <> rngCell2.Value2


    If blnCancel Then
        Call MsgBox(Prompt:="Total do not balance!", Title:="Cannot close workbook", Buttons:=vbExclamation + vbOKOnly)
    End If
    Cancel = blnCancel
End Sub

 

[Niven]

Hi Jon,

Thanks for the quick response. However I seem to be having a problem. The first line has been highlighted in yellow, and the sheet name appears in red. When I try to close it gives a syntax error.

Thanks.

 

[Jon von der Heyden]

where are the two cells? I.e. the cell addresses, and what are the sheet names they belong to?

 

[Niven]

Hi,

I managed to fix something. I left the Sheet name as "Sheet 1" instead of "Weekly Timesheet". But how do I have the same code for the rest of the cells in that column? Basically the one column from H24 to H30 calculates the total number of hours worked (from Monday to Sunday), and then K24 to K30 calculates the sum of the allocations between the projects. I entered the cell numbers individually in brackets separated by a comma but I guess that won't work since the code wouldn't know which two cells are being compared.

Thanks.

 

[Niven]

Hi, I changed the code as follows but now it doesn't allow me to close the workbook even though the numbers match.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim blnCancel As Boolean
Dim rngCell1 As Excel.Range, rngCell2 As Excel.Range
Dim rngCell3 As Excel.Range, rngCell4 As Excel.Range
Dim rngCell5 As Excel.Range, rngCell6 As Excel.Range
Dim rngCell7 As Excel.Range, rngCell8 As Excel.Range
Dim rngCell9 As Excel.Range, rngCell10 As Excel.Range
Dim rngCell11 As Excel.Range, rngCell12 As Excel.Range
Dim rngCell13 As Excel.Range, rngCell14 As Excel.Range
Dim rngCell15 As Excel.Range, rngCell16 As Excel.Range

With Sheet1 '<- change to reference the required sheet
Set rngCell1 = .Range("H24") '<- change to reference the required cell
Set rngCell2 = .Range("K24") '<- change to reference the required cell
Set rngCell3 = .Range("H25") '<- change to reference the required cell
Set rngCell4 = .Range("K25") '<- change to reference the required cell
Set rngCell5 = .Range("H26") '<- change to reference the required cell
Set rngCell6 = .Range("K26") '<- change to reference the required cell
Set rngCell7 = .Range("H27") '<- change to reference the required cell
Set rngCell8 = .Range("K27") '<- change to reference the required cell
Set rngCell9 = .Range("H28") '<- change to reference the required cell
Set rngCell10 = .Range("K28") '<- change to reference the required cell
Set rngCell11 = .Range("H29") '<- change to reference the required cell
Set rngCell12 = .Range("K29") '<- change to reference the required cell
Set rngCell13 = .Range("H30") '<- change to reference the required cell
Set rngCell14 = .Range("K30") '<- change to reference the required cell
Set rngCell15 = .Range("H31") '<- change to reference the required cell
Set rngCell16 = .Range("K31") '<- change to reference the required cell
End With

blnCancel = rngCell1.Value2 <> rngCell2.Value2
blnCancel = rngCell3.Value2 <> rngCell4.Value2
blnCancel = rngCell5.Value2 <> rngCell6.Value2
blnCancel = rngCell7.Value2 <> rngCell8.Value2
blnCancel = rngCell9.Value2 <> rngCell10.Value2
blnCancel = rngCell11.Value2 <> rngCell12.Value2
blnCancel = rngCell13.Value2 <> rngCell14.Value2
blnCancel = rngCell15.Value2 <> rngCell16.Value2

If blnCancel Then
Call MsgBox(Prompt:="Have ALL hours worked been allocated to a project?", Title:="Cannot close workbook", Buttons:=vbExclamation + vbOKOnly)
End If
Cancel = blnCancel
End Sub

 

[Niven]

Hi.

The code below allows an error message when Cell 15 does not equal Cell 16 but it does not give an error message for the others. What I am missing?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim blnCancel As Boolean
Dim rngCell1 As Excel.Range, rngCell2 As Excel.Range
Dim rngCell3 As Excel.Range, rngCell4 As Excel.Range
Dim rngCell5 As Excel.Range, rngCell6 As Excel.Range
Dim rngCell7 As Excel.Range, rngCell8 As Excel.Range
Dim rngCell9 As Excel.Range, rngCell10 As Excel.Range
Dim rngCell11 As Excel.Range, rngCell12 As Excel.Range
Dim rngCell13 As Excel.Range, rngCell14 As Excel.Range
Dim rngCell15 As Excel.Range, rngCell16 As Excel.Range

With Sheet1 '<- change to reference the required sheet
Set rngCell1 = .Range("H24") '<- change to reference the required cell
Set rngCell2 = .Range("K24") '<- change to reference the required cell
Set rngCell3 = .Range("H25") '<- change to reference the required cell
Set rngCell4 = .Range("K25") '<- change to reference the required cell
Set rngCell5 = .Range("H26") '<- change to reference the required cell
Set rngCell6 = .Range("K26") '<- change to reference the required cell
Set rngCell7 = .Range("H27") '<- change to reference the required cell
Set rngCell8 = .Range("K27") '<- change to reference the required cell
Set rngCell9 = .Range("H28") '<- change to reference the required cell
Set rngCell10 = .Range("K28") '<- change to reference the required cell
Set rngCell11 = .Range("H29") '<- change to reference the required cell
Set rngCell12 = .Range("K29") '<- change to reference the required cell
Set rngCell13 = .Range("H30") '<- change to reference the required cell
Set rngCell14 = .Range("K30") '<- change to reference the required cell
Set rngCell15 = .Range("H31") '<- change to reference the required cell
Set rngCell16 = .Range("K31") '<- change to reference the required cell
End With

blnCancel = rngCell1.Value2 <> rngCell2.Value2
blnCancel = rngCell3.Value2 <> rngCell4.Value2
blnCancel = rngCell5.Value2 <> rngCell6.Value2
blnCancel = rngCell7.Value2 <> rngCell8.Value2
blnCancel = rngCell9.Value2 <> rngCell10.Value2
blnCancel = rngCell11.Value2 <> rngCell12.Value
blnCancel = rngCell13.Value2 <> rngCell14.Value
blnCancel = rngCell15.Value2 <> rngCell16.Value2
If blnCancel Then
Call MsgBox(Prompt:="Have ALL hours worked been allocated to a project?", Title:="Cannot close workbook", Buttons:=vbExclamation + vbOKOnly)
End If
Cancel = blnCancel
End Sub

 

[nuked]

You're missing the fact that blnCancel is being constantly changed, making the only relevant test the final one out of the 8 you currently have.

 

[Niven]

Okay thanks but how do I change that?

 

[Jon von der Heyden]

I would recommend that you use a formula to determine whether or not all the components stack up. E.g. somewhere in your sheet (or in a name)

=AND(H24:H31=K24:K31)
...confirmed with control+shift+enter

So lets say this formula is in a sheet called "Sheet1" and in cell A1, the VBA:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim blnCancel As Boolean
    Dim rngCell1 As Excel.Range, rngCell2 As Excel.Range


    blnCancel = Not Sheets("Sheet1").Range("A1").Value


    If blnCancel Then
        Call MsgBox(Prompt:="Total do not balance!", Title:="Cannot close workbook", Buttons:=vbExclamation + vbOKOnly)
    End If
    Cancel = blnCancel
End Sub