I have a worksheet where users need to input information. There are two requirements that need to be met before users can save the file
- There can't be any cells filled in "red" (this happens if they don't provide detail that is required)
- The Buy Ready Date (column K) cannot be prior to Today
If either of these occur, the user should get an error message and not be able to save the file
I can get both conditions to work and prevent users from saving, however it gives a pop-up error message for every single cell that has an error.
Is there a way to set it up do that for each condition there is only one pop-up message that says there are required cells that need to be filled in and/or there are Buy Ready Dates that are prior to Today's date
If the user has errors for both conditions they will get 2 pop-up error messages (one for each condition not being met), rather than one for each cell with errors
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim rngCondFormat As Range
Dim rng As Range
Dim cell As Range
'Attempting to Reference SpecialCells(xlCellTypeAllFormatConditions)
'produces an error if no cells meet the criteria so need to test
'using the following routine.
On Error Resume Next
Set rngCondFormat = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0
If Not rngCondFormat Is Nothing Then 'Not nothing then is something (Valid)
For Each rng In rngCondFormat
'Use DisplayFormat to return Conditional Format color.
If rng.DisplayFormat.Interior.ColorIndex = 3 Then
MsgBox ("Missing required information in cell " & rng.Address(0, 0))
Cancel = True
Application.ScreenUpdating = True
Exit Sub
End If
Next rng
End If
For Each cell In Range("K2:K1001")
If cell.Value < Now() And cell.Value <> "" Then
Cancel = True
MsgBox ("Buy Ready Date cannot be prior to Today's date in cell " & cell.Address(0, 0))
End If
Next
End Sub
I have a worksheet where users need to input information. There are two requirements that need to be met before users can save the file
- There can't be any cells filled in "red" (this happens if they don't provide detail that is required)
- The Buy Ready Date (column K) cannot be prior to Today
If either of these occur, the user should get an error message and not be able to save the file
I can get both conditions to work and prevent users from saving, however it gives a pop-up error message for every single cell that has an error.
Is there a way to set it up do that for each condition there is only one pop-up message that says there are required cells that need to be filled in and/or there are Buy Ready Dates that are prior to Today's date
If the user has errors for both conditions they will get 2 pop-up error messages (one for each condition not being met), rather than one for each cell with errors
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim rngCondFormat As Range
Dim rng As Range
Dim cell As Range
'Attempting to Reference SpecialCells(xlCellTypeAllFormatConditions)
'produces an error if no cells meet the criteria so need to test
'using the following routine.
On Error Resume Next
Set rngCondFormat = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0
If Not rngCondFormat Is Nothing Then 'Not nothing then is something (Valid)
For Each rng In rngCondFormat
'Use DisplayFormat to return Conditional Format color.
If rng.DisplayFormat.Interior.ColorIndex = 3 Then
MsgBox ("Missing required information in cell " & rng.Address(0, 0))
Cancel = True
Application.ScreenUpdating = True
Exit Sub
End If
Next rng
End If
For Each cell In Range("K2:K1001")
If cell.Value < Now() And cell.Value <> "" Then
Cancel = True
MsgBox ("Buy Ready Date cannot be prior to Today's date in cell " & cell.Address(0, 0))
End If
Next
End Sub
1 Answer
Reset to default 1You can check for each potential problem before showing any message to your user.
For example:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rngCondFormat As Range, rng As Range
Dim cell As Range, msg As String
On Error Resume Next 'avoid runtime error if no formatted cells
Set rngCondFormat = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0
If Not rngCondFormat Is Nothing Then 'Not nothing then is something (Valid)
For Each rng In rngCondFormat.Cells
'Use DisplayFormat to return Conditional Format color.
If rng.DisplayFormat.Interior.ColorIndex = 3 Then
AddMessage msg, "Missing information in red-shaded cell(s) in range " & _
rngCondFormat.Address(False, False)
Exit For
End If
Next rng
End If
For Each cell In Range("K2:K1001").Cells
If cell.Value < Now() And cell.Value <> "" Then
AddMessage msg, "Buy Ready Date cannot be prior " & _
"to Today's date (for example: " & cell.Address(0, 0) & ")"
Exit For
End If
Next
If Len(msg) > 0 Then 'any problems to fix ?
Cancel = True
MsgBox "Please resolve issue(s) below before saving:" & _
vbLf & vbLf & msg, vbExclamation, _
Title:="Fixes needed before saving"
End If
End Sub
'Helper sub for appending messages
' ByRef added to remind caller that `msg` gets modified in the Sub.
Sub AddMessage(ByRef msg As String, addThis As String)
msg = msg & IIf(Len(msg) > 0, vbLf & vbLf, "") & addThis
End Sub