bananas
bananas

Reputation: 11

Combining code that forces user to enable macro and code that makes cells mandatory

Big thanks to A.S.H for helping me with out with this code earlier.

Right now, I'm attempting to show a splash sheet that tells users to enable macros in order to access the workbook. The plan is to save the file with the splash sheet visible and other sheets veryhidden during the BeforeClose event. During the Open event, the splash sheet will be made veryhidden and the other sheets will be made visible.

Hence, the user will only see the splash sheet when he/she opens the file with macros disabled. However with the below code, it doesn't seem as though the routine that makes the splash sheet visible and the rest veryhidden is running. Where have I gone wrong?

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rs As Object, ws As Object
Dim Ans As Integer
Dim target As Range, r As Range
Set rs = Sheets("Report")
If Me.Saved = False Then
    Do
        Ans = MsgBox("Do you want to save the changes you made to '" & _
            Me.Name & "'?", vbQuestion + vbYesNoCancel)
        Select Case Ans
            Case vbYes
                With rs
                    Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
                End With
                target.Value = Application.Trim(target.Value)
                For Each r In target.Rows
                    If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") > 0 Then
                        Cancel = True
                        r.Parent.Activate: r.Activate
                        MsgBox ("Please confirm all required fields have been completed")
                        Exit Sub
                    End If
                Next
                Application.ScreenUpdating = False
                Sheets("Reminder").Visible = xlSheetVisible
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Name <> "Reminder" Then
                        ws.Visible = xlSheetVeryHidden
                    End If
                Next ws
                ActiveWorkbook.Save
                For Each ws In ThisWorkbook.Worksheets
                    If ws.Name <> "Reminder" Then
                        ws.Visible = xlSheetVisible
                    End If
                Next ws
                Sheets("Reminder").Visible = xlSheetVeryHidden
                ThisWorkbook.Saved = True
                Application.ScreenUpdating = True
            Case vbNo
                Me.Saved = True
            Case vbCancel
                Cancel = True
                Exit Sub
        End Select
    Loop Until ThisWorkbook.Saved = True
End If
End Sub

Upvotes: 1

Views: 111

Answers (1)

A.S.H
A.S.H

Reputation: 29332

If you are experiencing screen trouble, it is likely due to some erroneous manipulation of Application.ScreenUpdating here and in other macros. In this one, the error is that you first set it to False and then Exit Sub without restoring it to True.

Moreover, since your routine only does calculation (checking) and does not change cell values, there's no point in disabling Application.ScreenUpdating.

On a side note, I think your routine that checks for empty cells can be much simplified.

Function dataIsValid() As Boolean
    Dim target As Range, r As Range
    With ActiveSheet ' <-- May be better change to some explicit sheet name
        Set target = .Range("B5:R" & .Cells(.Rows.Count, 2).End(xlUp).Row)
    End With
    target.value = Application.Trim(target.value) ' <-- trim the whole range
    For Each r In target.Rows
        If Not IsEmpty(r.Cells(1)) And Application.CountIf(r, "") Then
            r.Parent.Activate: r.Activate ' <-- Show erroneous row
            MsgBox ("Please confirm all required fields have been completed")
            Exit Function
        End If
    Next
    dataIsValid = True
End Function

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cancel = Not dataIsValid
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = Not dataIsValid
End Sub

Upvotes: 1

Related Questions