This is my first time trying to code with VBA. I have a drop down list in cell A2 and a drop down list in cell B2.
If A2 and B2 are populated (NotBlank?) then the user must enter text into D2 (I would like to make sure the text is longer than 10 characters- hoping no one presses the space bar 10 times) or they can’t save (BeforeSave?) else they can save.
I need to make it loop as well. That is, if A3 and B3 are not empty then D3 is mandatory etc. I hope this is clear. Please let me know if I need to explain more.
Here is the code. It works for that one cell, but how do I make it repeat? Do I change the range?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If IsEmpty(Range("A2,B2")) = False Then
MsgBox "You must enter commentary to validate your ratings"
End If
End Sub
You need to loop through all used rows and check each cell on its own.
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet 'specify which sheet here
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long 'find last used row in column A
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long
For iRow = 2 To LastRow 'loop throug all used rows
If ws.Cells(iRow, "A").Value <> vbNullString And _
ws.Cells(iRow, "B").Value <> vbNullString And _
ws.Cells(iRow, "D").Value = vbNullString Then
MsgBox "You must enter commentary to validate your ratings. This file will not be saved!", vbExclamation
Cancel = True 'do not save
ws.Cells(iRow, "D").Select 'select missing cell
Exit For
End If
Next iRow
End Sub
Another idea
This will automatically select all missing cells, and has no loops.
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim ConstantsInA As Range
Set ConstantsInA = ws.Range("A2:A" & LastRow).SpecialCells(xlCellTypeConstants)
Dim ConstantsInB As Range
Set ConstantsInB = ws.Range("B2:B" & LastRow).SpecialCells(xlCellTypeConstants)
Dim EmptyCellsInD As Range
Set EmptyCellsInD = ws.Range("D2:D" & LastRow).SpecialCells(xlCellTypeBlanks)
Dim MissingValues As Range
Set MissingValues = Intersect(ConstantsInA.EntireRow, ConstantsInB.EntireRow, EmptyCellsInD)
If Not MissingValues Is Nothing Then
MissingValues.Select 'select missing cells
MsgBox "You must enter commentary to validate your ratings. This file will not be saved!", vbExclamation
Cancel = True 'do not save
End If
End Sub
Answer：
This should do what you want it to
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim c As Range
LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For Each c In Sheets("Sheet1").Range("A2:A" & LastRow)
If c.Value <> "" And c.Offset(0, 1).Value <> "" And c.Offset(0, 3).Value = "" Then
MsgBox "You must enter commentary in column D" & c.Row & " to validate your ratings before saving"
Cancel = True
End If
Next
End Sub
Tags: excelexcel, sed
