Home » excel » excel – Make Column mandatory based on drop downs in previous columns

excel – Make Column mandatory based on drop downs in previous columns

Posted by: admin May 14, 2020 Leave a comment

Questions:

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
How to&Answers:

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