VBA to make entry in column mandatory on certain condition

[marcwlms]

I hvae a spreadsheet used for logging employee relations cases. It alsready has the following VBA applied to it. Help on this was very kindly given on this forum at the time.

i now have to add an additional column which must only be mandatory if a certain value (Grievance) is selected in column H, for all other cases it can remain blank, i dont want to add it into the existing macro for this reason. I am also unsure how to add an addtional macro for column Q without messing up the existing macro.

Thanks in advance for any guidance!!

Marc

Option Explicit
Private Sub Workbook_Open()
  Application.Goto Worksheets("Formal").Cells(Rows.Count, "A").End(xlUp).Offset(1)
MsgBox "**WARNING**""When initially logging a case entries are mandatory in columns A - P." & vbNewLine & vbNewLine & "If you try to close or save the spreadsheet without completing these cells" & vbNewLine & "you will receive a warning showing which cells you have not completed." & vbNewLine & vbNewLine & "If you attempt to continue saving or closing the spreadsheet without these mandatory cells completed, your changes will NOT be saved"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Dim rngCell As Range, strBlanks As String
 
  Application.ScreenUpdating = False
 
  strBlanks = vbNullString
  For Each rngCell In Worksheets("Formal").Range("a2:a2000").Cells
  If Len(Trim(rngCell.Value)) > 0 Then
  If WorksheetFunction.CountA(rngCell.Offset(0, 1).Resize(1, 15)) < 15 Then
  strBlanks = strBlanks & IIf(Len(strBlanks) > 0, ",", "") & _
  Replace(rngCell.Offset(0, 1).Resize(1, 15).SpecialCells(xlCellTypeBlanks).Address, "$", "")
  End If
  End If
  Next
 
  If Not strBlanks = vbNullString Then
  MsgBox "**WARNING**" & vbNewLine & vbNewLine & "When initially logging a case entries are mandatory in columns A - P." & vbNewLine & vbNewLine & "Please complete entries in the following cells" & vbCrLf & vbCrLf & strBlanks
  Cancel = True
  Exit Sub
  End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim rngCell As Range, strBlanks As String
 
  Application.ScreenUpdating = False
 
  strBlanks = vbNullString
  For Each rngCell In Worksheets("Formal").Range("a2:a2000").Cells
  If Len(Trim(rngCell.Value)) > 0 Then
  If WorksheetFunction.CountA(rngCell.Offset(0, 1).Resize(1, 15)) < 15 Then
  strBlanks = strBlanks & IIf(Len(strBlanks) > 0, ",", "") & _
  Replace(rngCell.Offset(0, 1).Resize(1, 15).SpecialCells(xlCellTypeBlanks).Address, "$", "")
  End If
  End If
  Next
 
  If Not strBlanks = vbNullString Then
  MsgBox "**WARNING**" & vbNewLine & vbNewLine & "When initially logging a case entries are mandatory in columns A - P." & vbNewLine & vbNewLine & "Please complete entries in the following cells" & vbCrLf & vbCrLf & strBlanks
  Cancel = True
  Exit Sub
  End If
End Sub
[\CODE]

 

[Sathish KV]

Hi,

Could you upload a sample file

 

[marcwlms]

Dont think i can do that unfortunately