VBA FORCE CELL NOT WORKING

Can anybody see a fault with the following script as it just does not appear to work. The aim is to force users to populate cells before closing unless the workbook was opened as read only:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

With Sheets("adhoc and change of status")

If Not Me.ReadOnly Then

If WorksheetFunction.CountA(.Range("C4091:C6000,D4091:D6000,F4091:F6000,M4091: M6000,N4091:N6000,P4091:P6000,Q4091:Q6000")) <> 3 Then

MsgBox "You must complete C, D, F, M, N, P, Q as you did not open the spreadsheet read-only"

Cancel = True

End If

End If

End With

End Sub

I have no idea how that little blue face got there, it should read D!

Please use code tags !!

This may help a bit

[VBA]Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim a As Range
Dim b As Range
Dim wkstfnc As Double
With Sheets("adhoc and change of status")
Set a = .Range("A1:A2")
Set b = .Range("B1:B2")
End With
wkstfnc = WorksheetFunction.CountA(a, b)
If Not ThisWorkbook.ReadOnly Then

If wkstfnc <> 3 Then

MsgBox "You must complete C, D, F, M, N, P, Q as you did not open the spreadsheet read-only"

Cancel = True

End If

End If
Stop
End Sub
[/VBA]