Restrict Save/Save as excel if conditions are not met

[gmalpani]

Hi Experts,

I need help on VBA which pop up a message box with 'Yes' or 'No' asking users that "required mandatory are not yet met. Do you still want to save ?".
This VBA shall trigger when users try to save file. I already wrote first level macro but it is not working also I dont know how to write code to ask if they still want to save or not.

Row Range for this VBA -17 to 215 (but may be possible all are not used so probably end row can be identified within this range).
Condition to check for each row - check for each row if Cells(i, "R") is "Approved" and Cells(i,"W") is empty then this is a breach of mandatory condition.
Identify for how many rows this condition is not met and count the total rows.

Trigger this when user tries to save/save as and diplay a message box that Key in column W is missing for these many records. Do you still want to save ?

I tried a macro as given below but its not executing.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Long 'variable for row number
Dim j As Long 'variable to store total missing records
i = 17
j = 0
For Each Row In Sheets(">>Pre-C3Commitment_New<<").Range("C17:AG215")
If Cells(i, "R").Value = "2-APPROVED/ACTIVE" & IsEmpty(Cells(i, "W")) Then
j = j + 1
End If
Next Row
If j > 0 Then
Cancel = True
MsgBox "JIRA ID is missing for requests count - " & j, vbInformation
Else
'Do Nothing
End If
End Sub

Could you please help to fix the macro and add a code to ask user if he still wants to save the file.

 

[JackDanIce]

Try:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
       
    Dim v   As Long
    Dim x   As Long
    Dim i   As Long
   
    With Sheets(">>Pre-C3Commitment_New<<")
        x = .Cells(.Rows.Count, 18).End(xlUp).Row
        If x < 18 Then
            If MsgBox("No requests found, continue save?", vbYesNo, "No Requests Found") = vbYes Then            
               Cancel = True
           Else
               Cancel = False
           End If
        Else
            v = .Cells(17, 18).Resize(x - 17, 6).Value
            For x = LBound(v, 1) To UBound(v, 1)
                If v(x, 1) & v(x, 6) = "2-APPROVED/ACTIVE" Then i = i + 1
            Next x
        End If
    End With
   
    If i Then
        If MsgBox("JIRA ID missing for requests count:" & vbCrLf & vbCrLf & i & vbCrLf & vblcrf & "Do you still wish to save?", vbExclamation + vbYesNo, "Missing JIRA IDs Found") = vbYes Then
        Cancel = True
    Else
        Cancel = True
    End If
   
End Sub

 

[gmalpani]

Hi Jack,

Thanks for your quick help. However, it is giving me a Compile Error and also it is bit hard for me to understand the code.
So, I instead modified my original code with help of google and other answered threads. It worked for me now. Thanks again for your help.

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

Dim c As Range, j As Long
Dim answer As Integer

With Sheets(">>Sheet_New<<")
  For Each c In .Range("F17", .Range("F" & Rows.Count).End(xlUp))
    If c.Value = "1-Active" And (c.Offset(, 12).Value) = "2-APPROVED/ACTIVE" And IsEmpty(c.Offset(, 17).Value) Then j = j + 1
  Next
End With

If j > 0 Then
answer = MsgBox("It is mandatory to add Key in Column 'W' against each Approved feature request." & vbCrLf & vbCrLf & "Missing Key:" & j & vbCrLf & vbCrLf & "Do you still wish to save?", vbQuestion + vbYesNo + vbDefaultButton2, "Check for Product Managers")
    If answer = vbYes Then
    Cancel = False
    Else
    Cancel = True
    End If
End If
End Sub

 

[JackDanIce]

No worries, what line did it error on? Glad you have something that works though