Make certain cell Required if cell B in that row has value

hajiali

Well-known Member
Joined
Sep 8, 2018
Messages
624
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone

What I need is if cell B2 has value then make Cell C2, D2, J2, K2, R2 required before allowing users move to another row or sheet on the excel.

on top of that i would like an error message to populate to inform user what column they need to fill. for ex. C= first name D= Last name J = date of hire K=DOB R= Full or Part time
if Column R of the Row is blank have message populate. You must fill Full-time Part-time Column for employee

any suggestion is greatly appreciated.

Thanks
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Do you want to do this only for row 2 or for all rows? It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet.
 
Upvote 0
I would want this to happen to Rows 2 thru 1000
so if any row in column B has value then that row columns C, D, J, K, R required

I was using B2 as an example.
if B# <>"" then C#, D#, J#, K#, R# are required to fill out

Hope this clearifies
 
Upvote 0
This would be my suggestion:
Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Change all occurrences of the sheet name (in red) to suit your needs. Close the code window to return to your sheet.
Rich (BB code):
Private Sub Worksheet_Deactivate()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    For x = 2 To LastRow
        If Sheets("Sheet1").Range("B" & x) <> "" Then
            For Each rng In Sheets("Sheet1").Range("C" & x & ",D" & x & ",J" & x & ",K" & x & ",R" & x)
                If rng = "" Then
                    Sheets("Sheet1").Activate
                    MsgBox ("Make sure you have filled in the first and last name, date of hire, DOB and full or part time in row " & rng.Row & "." & " The " & Cells(1, rng.Column) & " is missing.")
                    Cells(rng.Row, rng.Column).Select
                    Exit Sub
                End If
            Next rng
        End If
    Next x
    Application.ScreenUpdating = True
Place these macros in the code module for ThisWorkbook. Do the following: Hold down the ALT key and press the F11 key. This will open the Visual Basic Editor. In the left hand pane, double click on "ThisWorkbook". Copy/paste the macros into the empty window that opens up. Change all occurrences of the sheet name (in red) to suit your needs. Close the window to return to your sheet.
Rich (BB code):
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    For x = 2 To LastRow
        If Sheets("Sheet1").Range("B" & x) <> "" Then
            For Each rng In Sheets("Sheet1").Range("C" & x & ",D" & x & ",J" & x & ",K" & x & ",R" & x)
                If rng = "" Then
                    Sheets("Sheet1").Activate
                    MsgBox ("Make sure you have filled in the first and last name, date of hire, DOB and full or part time in row " & rng.Row & "." & " The " & Cells(1, rng.Column) & " is missing.")
                    Cells(rng.Row, rng.Column).Select
                    Cancel = True
                    Exit Sub
                End If
            Next rng
        End If
    Next x
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Application.ScreenUpdating = False
    Dim LastRow As Long, rng As Range, x As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
    For x = 2 To LastRow
        If Sheets("Sheet1").Range("B" & x) <> "" Then
            For Each rng In Sheets("Sheet1").Range("C" & x & ",D" & x & ",J" & x & ",K" & x & ",R" & x)
                If rng = "" Then
                    Sheets("Sheet1").Activate
                    MsgBox ("Make sure you have filled in the first and last name, date of hire, DOB and full or part time in row " & rng.Row & "." & " The " & Cells(1, rng.Column) & " is missing.")
                    Cells(rng.Row, rng.Column).Select
                    Cancel = True
                    Exit Sub
                End If
            Next rng
        End If
    Next x
End Sub
These macros will check for missing data when you select another sheet, before saving and before closing the workbook. They will display a message and take the user to the cell that is missing the information.
 
Upvote 0
Mine is a pretty agressive response. The user can't do anything (including select cells on a different row) until all of the required cells are filled out.
Put this in the sheet's code module for the sheet in question.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LockDown As Boolean
    With Target
        If .Cells.Count = 1 And 2 <= .Row Then
            With .EntireRow
                If .Range("B1") = vbNullString Then
                    Me.ScrollArea = ""
                Else
                    LockDown = (.Range("C1") = vbNullString) Or (.Range("d1") = vbNullString) Or .Range("j1").Value = vbNullString _
                                        Or (.Range("K1") = vbNullString) Or (.Range("R1") = vbNullString)
                    If LockDown Then
                         GoSub GotoNextCell
                        If Me.ScrollArea = vbNullString Then
                                With .Range("b1:R1")
                                    MsgBox "columns C,D,J,K and R must be filled in before proceeding."
                                    Me.ScrollArea = .Address(False, False)
                                End With
                            End If
                        Else
                        Me.ScrollArea = vbNullString
                        ActiveCell.Offset(1, 0).Select
                    End If
                End If
            End With
        End If
    End With
    Exit Sub
GotoNextCell:
    With Target.EntireRow
        If .Range("c1").Value = vbNullString Then
            .Range("C1").Select
        ElseIf .Range("d1").Value = vbNullString Then
            .Range("D1").Select
        ElseIf .Range("j1").Value = vbNullString Then
            .Range("J1").Select
        ElseIf .Range("k1").Value = vbNullString Then
            .Range("K1").Select
        ElseIf .Range("r1").Value = vbNullString Then
            .Range("r1").Select
        End If
    End With
    Return
End Sub
 
Upvote 0
If i already have the Following code
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim resp As VbMsgBoxResult
  If Not Intersect(Target, Range("A2:A1000")) Is Nothing Then
    Cancel = True
    resp = MsgBox(Prompt:="THIS WILL REMOVE EMPLOYEE FROM THE ROSTER. DO YOU WISH TO CONTINUE?", Buttons:=vbYesNoCancel)
    If resp = vbYes Then
      ActiveSheet.Unprotect Password:="BNA262"
      Range(Replace("B#:D#,H#:T#,V#:AV#,AX#:BG#", "#", Target.Row)).ClearContents
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A1:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
      ActiveSheet.Protect Password:="BNA262"
    End If
  End If
    If Not Intersect(Target, Range("A1")) Is Nothing Then
    Cancel = True
      ActiveSheet.Unprotect Password:="BNA262"
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A1:A1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
      ActiveSheet.Protect Password:="BNA262"
End If
    If Not Intersect(Target, Range("D1")) Is Nothing Then
    Cancel = True
      ActiveSheet.Unprotect Password:="BNA262"
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Add Key _
        :=Range("D1:D1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
      ActiveSheet.Protect Password:="BNA262"
End If
    If Not Intersect(Target, Range("C1")) Is Nothing Then
    Cancel = True
      ActiveSheet.Unprotect Password:="BNA262"
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort.SortFields.Add Key _
        :=Range("C1:C1000"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EMPLOYEE LIST").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With
      ActiveSheet.Protect Password:="BNA262"
End If
    If Selection.Count = 1 Then
        If Not Intersect(Target, Range("B1")) Is Nothing Then
        Call PrintEmployeeList
        End If
    End If
End Sub

Do I need to do anything else or combine them for any reason
 
Upvote 0

Forum statistics

Threads
1,214,925
Messages
6,122,298
Members
449,077
Latest member
Rkmenon

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