How to make a number of cells mandatory if another cell is populated?

MW_BAH

New Member
Joined
Apr 10, 2023
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi everyone - newbie to the forum here looking for some help

I have a sheet where I want to make certain cells in a row mandatory if a specific cell in the same row is not blank. For example, if B1 is not blank then cells C1, D1, E1 and M1 must be filled in. I would need this to apply to every row on the sheet and display an error message before save and close if any of the mandatory cells are blank, unless of course column 1 is blank. All cells would be free-type and not using drop downs.

I understand I can probably use VBA to do this but have no idea what code to use so would appreciate any advice and step by step guidance on how to do this.

Thanks!
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
I used this as test data:

test.xlsm
ABCDEF
11sabcd
22fddd
33221234
4423134
5524abcd
6625abd
7713
Sheet1


The code I used is below, it needs to be pasted into the 'ThisWorkBook' pane in VBA Developer (Alt-F11):

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sProblemRows As String
    Dim n As Integer
    
    With Worksheets("Sheet1")
        For n = 1 To .UsedRange.Rows.Count
            If .Cells(n, 2) <> "" Then
                If .Range("C1").Offset(n - 1, 0) = "" Or .Range("D1").Offset(n - 1, 0) = "" Or .Range("E1").Offset(n - 1, 0) = "" Or .Range("F1").Offset(n - 1, 0) = "" Then
                    sProblemRows = sProblemRows & n & ", "
                End If
            End If
        Next n
        If sProblemRows <> "" Then
            MsgBox "The following rows are not complete: " & sProblemRows & Chr$(10) & Chr$(10) & "The sheet has not been saved"
            Cancel = True
        End If
    End With
End Sub
 
Upvote 0
T
I used this as test data:

test.xlsm
ABCDEF
11sabcd
22fddd
33221234
4423134
5524abcd
6625abd
7713
Sheet1


The code I used is below, it needs to be pasted into the 'ThisWorkBook' pane in VBA Developer (Alt-F11):

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sProblemRows As String
    Dim n As Integer
  
    With Worksheets("Sheet1")
        For n = 1 To .UsedRange.Rows.Count
            If .Cells(n, 2) <> "" Then
                If .Range("C1").Offset(n - 1, 0) = "" Or .Range("D1").Offset(n - 1, 0) = "" Or .Range("E1").Offset(n - 1, 0) = "" Or .Range("F1").Offset(n - 1, 0) = "" Then
                    sProblemRows = sProblemRows & n & ", "
                End If
            End If
        Next n
        If sProblemRows <> "" Then
            MsgBox "The following rows are not complete: " & sProblemRows & Chr$(10) & Chr$(10) & "The sheet has not been saved"
            Cancel = True
        End If
    End With
End Sub
Thanks for this. I have put this into VBA Developer and it works but only for row 1. How do i make it so that if a value is added to, let's say, B25, that cells C25, D25 etc are mandatory?

Apologies if i have missed something obvious here, I am new to using VBA
 
Upvote 0
T

Thanks for this. I have put this into VBA Developer and it works but only for row 1. How do i make it so that if a value is added to, let's say, B25, that cells C25, D25 etc are mandatory?

Apologies if i have missed something obvious here, I am new to using VBA
Ignore this, sorry, all working fine as far as i can see. Thank you for the help
 
Upvote 0
my pleasure - thanks for the prompt feedback. One point, based on your original post you should change this
VBA Code:
Or .Range("F1")
to
VBA Code:
Or .Range("M1")
.
 
Upvote 0
I used this as test data:

test.xlsm
ABCDEF
11sabcd
22fddd
33221234
4423134
5524abcd
6625abd
7713
Sheet1


The code I used is below, it needs to be pasted into the 'ThisWorkBook' pane in VBA Developer (Alt-F11):

VBA Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim sProblemRows As String
    Dim n As Integer
   
    With Worksheets("Sheet1")
        For n = 1 To .UsedRange.Rows.Count
            If .Cells(n, 2) <> "" Then
                If .Range("C1").Offset(n - 1, 0) = "" Or .Range("D1").Offset(n - 1, 0) = "" Or .Range("E1").Offset(n - 1, 0) = "" Or .Range("F1").Offset(n - 1, 0) = "" Then
                    sProblemRows = sProblemRows & n & ", "
                End If
            End If
        Next n
        If sProblemRows <> "" Then
            MsgBox "The following rows are not complete: " & sProblemRows & Chr$(10) & Chr$(10) & "The sheet has not been saved"
            Cancel = True
        End If
    End With
End Sub
Sorry to bother you again on this. I have adapted the code slightly to cover all the columns I need and it is working fine in the desktop version of Excel. Is there a way to make this work when the workbook is uploaded to an online sharepoint? At the moment, it is not working. Work is autosaved in the sharepoint site so there is no requirement for people to click save or even close the workbook, they can just close the tab or go back to the file list.
 
Upvote 0
try pasting this into the worksheet code (right click sheet name and select view code): if it works as expected it will make it difficult to leave lines which are incomplete.
VBA Code:
Option Explicit
Public nPreviousRow As Integer

Private Sub Worksheet_Activate()
    nPreviousRow = ActiveCell.Row
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sProblemCells As String
    Dim n As Integer
    
    Application.EnableEvents = False

    n = nPreviousRow
    If ActiveSheet.Name = "Sheet1" Then
        If Cells(n, 2) <> "" Then
            With Worksheets("Sheet1")
                If .Range("C1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("C1").Offset(n - 1, 0).Address & ", "
                End If
                If .Range("D1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("D1").Offset(n - 1, 0).Address & ", "
                End If
                If Range("E1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("E1").Offset(n - 1, 0).Address & ", "
                End If
                If .Range("F1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("F1").Offset(n - 1, 0).Address & ", "
                End If
            End With
        End If
        If sProblemCells <> "" Then
            MsgBox "The following row is not complete: " & nPreviousRow & ", the missing cell(s) are: " & sProblemCells & _
                    Chr$(10) & Chr$(10) & "You must complete the relevant columns before selecting another row"
            Worksheets("Sheet1").Range(Left(sProblemCells, InStr(sProblemCells, ", ") - 1)).Activate
        End If
        nPreviousRow = Target.Row
    End If
    Application.EnableEvents = True

End Sub
 
Upvote 0
try pasting this into the worksheet code (right click sheet name and select view code): if it works as expected it will make it difficult to leave lines which are incomplete.
VBA Code:
Option Explicit
Public nPreviousRow As Integer

Private Sub Worksheet_Activate()
    nPreviousRow = ActiveCell.Row
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim sProblemCells As String
    Dim n As Integer
   
    Application.EnableEvents = False

    n = nPreviousRow
    If ActiveSheet.Name = "Sheet1" Then
        If Cells(n, 2) <> "" Then
            With Worksheets("Sheet1")
                If .Range("C1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("C1").Offset(n - 1, 0).Address & ", "
                End If
                If .Range("D1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("D1").Offset(n - 1, 0).Address & ", "
                End If
                If Range("E1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("E1").Offset(n - 1, 0).Address & ", "
                End If
                If .Range("F1").Offset(n - 1, 0) = "" Then
                    sProblemCells = sProblemCells & .Range("F1").Offset(n - 1, 0).Address & ", "
                End If
            End With
        End If
        If sProblemCells <> "" Then
            MsgBox "The following row is not complete: " & nPreviousRow & ", the missing cell(s) are: " & sProblemCells & _
                    Chr$(10) & Chr$(10) & "You must complete the relevant columns before selecting another row"
            Worksheets("Sheet1").Range(Left(sProblemCells, InStr(sProblemCells, ", ") - 1)).Activate
        End If
        nPreviousRow = Target.Row
    End If
    Application.EnableEvents = True

End Sub
Unfortunately, nothing appears to happen when I do this :(
 
Upvote 0
are you sure you've put it in the correct place? it only works if you put it in the Worksheet Code, not in 'ThisWorkBook' or a code module, see below:

1681142898515.png
 
Upvote 0
are you sure you've put it in the correct place? it only works if you put it in the Worksheet Code, not in 'ThisWorkBook' or a code module, see below:

View attachment 89376
Yes that is where I have put it. I can still enter data into the mandatory cells, save and exit. I did get a message giving me the option to either 'End' or 'Debug' after the first time I did it.
 
Upvote 0

Forum statistics

Threads
1,223,989
Messages
6,175,799
Members
452,670
Latest member
nogarth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top