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

[MW_BAH]

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!

 

[pjmorris]

I used this as test data:

test.xlsm
	A	B	C	D	E	F
1	1	s	a	b	c	d
2	2		fd		dd
3	3	22	1	2	3	4
4	4	23	1		3	4
5	5	24	a	b	c	d
6	6	25	a	b		d
7	7		1	3
Sheet1

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

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

 

[MW_BAH]

T

I used this as test data:

test.xlsm
	A	B	C	D	E	F
1	1	s	a	b	c	d
2	2		fd		dd
3	3	22	1	2	3	4
4	4	23	1		3	4
5	5	24	a	b	c	d
6	6	25	a	b		d
7	7		1	3
Sheet1

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

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

 

[MW_BAH]

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

 

[pjmorris]

my pleasure - thanks for the prompt feedback. One point, based on your original post you should change this

Or .Range("F1")

to

Or .Range("M1")

.

 

[MW_BAH]

I used this as test data:

test.xlsm
	A	B	C	D	E	F
1	1	s	a	b	c	d
2	2		fd		dd
3	3	22	1	2	3	4
4	4	23	1		3	4
5	5	24	a	b	c	d
6	6	25	a	b		d
7	7		1	3
Sheet1

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

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.

 

[pjmorris]

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.

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

 

[MW_BAH]

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.

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

 

[pjmorris]

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:

 

[MW_BAH]

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.