Excel VBA Prevent Save with Multiple Criteria

Question

I've been working with VBA in a template spreadsheet to prevent users from saving without certain fields being populated. As the time has gone by, I've been requested to make a few stipulations on the entries being required based on the contents of other cells. I have a bunch of data validation with drop-downs in my spreadsheet, so I'm too concerned about the targeting specific phrases to bypass requiring an entry to save the document. I need to keep all of the existing mandatory fields, but add in the exemptions below.

I currently have column M as a required columns if another of the other specified columns in that row are filled. Per above, trying to make column M required for all scenarios except the following. In the attempt to simplify the criteria, I've substituted the actual text required in both scenarios:

Column M is not required if column G = "Alpha" and column J = "Bravo".
Column M is not required if if the last four characters in column H are "abcd".

My current code is below. This is revised from when the question was initially asked

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Const CHECK_RNG As String = "A1:D1,F1:K1,N1:N1,S1:Y1,AE1"
    Dim ws As Worksheet
    Dim rg As Range, c As Range
    Dim bCanSave As Boolean, sep As String
    Dim sWarning As String, sMissing As String, r As Long, ct As Long

    Set ws = Sheets("Main")

    sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine
    bCanSave = True


    For r = 2 To 1000
        Set rg = ws.Rows(r).Range(CHECK_RNG)
        ct = Application.CountA(rg)
        If ct > 0 And ct <> rg.Cells.Count Then
            bCanSave = False
            sMissing = sMissing & sep & r
            sep = ","
        End If
    Next r

    If Not bCanSave Then
        MsgBox sWarning & sMissing, vbExclamation
        Cancel = True
    End If


End Sub

@SJR, right now if there is data in columns A-D, F-K, S-Y, or AE in any given row, column M is required in that row for the spreadsheet to be saved. Per what I have in question, I'm trying to make stipulations in those other columns so that column M can be left blank and still allow the spreadsheet to save. — rant
Yes I see that, but what exactly is the difficulty you are having in implementing this? Have you tried code which hasn't worked? If so, please post it. — SJR
I would check column M first and if there is a value then move to the next row, if not then do your validation checks. No reason to check all the others if Column M has valid required data. I do not see in your posted code, as noted by @SJR, any check for values. — Sorceri
@SJR: I don't have any new code for what I'm trying to achieve. I know little of VBA, and am really just an effective Googler. I've been able to find some thoughts on it, but nothing that's I've been able to get to work, even independent of the existing code. Another user on Stack Overflow helped clean up the code above, from something I had pieced together from a few different websites, but inserting these new stipulations is over my head. — rant

SJR SJR · Accepted Answer · 2018-01-05T19:36:56

I'm not entirely sure this is what you're after as your current code doesn't appear to me to do what you say it does so I may have misunderstood.

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

Dim ws As Worksheet
Dim bCanSave As Boolean, sep As String
Dim sWarning As String, sMissing As String, r As Long, ct As Long
Dim wf As WorksheetFunction, r1 As Range, r2 As Range, b As Boolean

Set ws = Sheets("Main")
Set wf = WorksheetFunction

sWarning = "File not saved!" & vbNewLine & "Mandatory cells missing in rows: " & vbNewLine
bCanSave = True
ActiveSheet.UsedRange.Interior.Color = xlNone
For r = 2 To 10
    Set r1 = Union(Cells(r, "A").Resize(, 4), Cells(r, "F").Resize(, 6), Cells(r, "M"), Cells(r, "S").Resize(, 7), Cells(r, "AE"))
    If If wf.CountA(r1) = r1.Count - 1 And (Cells(r, "M") = vbNullString And _
            (Cells(r, "G") = "Alpha" And Cells(r, "J") = "Bravo") Or Right(Cells(r, "H"), 4) = "abcd") Then
                'no problem
    Else
        If wf.CountA(r1) > 0 And wf.CountA(r1) < r1.Count Then
            For Each r2 In r1.Areas
                If wf.CountBlank(r2) > 0 Then
                    If r2.Count > 1 Then
                        r2.SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
                    Else
                        r2.Interior.Color = vbYellow
                    End If
                    b = True
                End If
            Next r2
        End If
        If b Then
            bCanSave = False
            sMissing = sMissing & sep & r
            sep = ","
            b = False
        End If
    End If
Next r

If Not bCanSave Then
    MsgBox sWarning & sMissing, vbExclamation
    Cancel = True
End If

End Sub

Excel VBA Prevent Save with Multiple Criteria

1 Answers