How can I use this formula for other rows?

[Kusaywa]

This formula makes it so that if something is entered in cell B2, it requires you to put something in D2. A pop-up appears and you can't continue until you do.
How can I make this do this for other rows?
Something in B3, requires you to put something in D3, and so on.
Thanks for any help.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim B As Range, D As Range
Set B = Range("B2")
Set D = Range("D2")
If B <> "" And D = "" Then
Application.EnableEvents = False
D.Select
Application.EnableEvents = True
MsgBox "Your ID Number is Required"
End If
End Sub

 

[Michael M]

maybe this...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range, lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B2:B" & lr)
For Each cell In myrange
If cell.Value <> "" And cell.Offset(0, 2).Value = "" Then
MsgBox "Your ID Number is Required"
Application.EnableEvents = False
cell.Offset(0, 2).Select
Application.EnableEvents = True
Exit Sub
End If
Next cell
End Sub

 

[Kusaywa]

Thanks Michael M, that did the trick!
This is what I was trying to do...
These 2 codes combined make it so when someone enters something in line B2, they must confirm they want to enter it.
Once they do, it can't be deleted.
It then forces them to enter something in D2, again confirming it and can't be deleted.
Thought it might help someone else.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 2 Or 4 Then
confirm = MsgBox("Do you wish to confirm entry of this data?", vbYesNo, "confirm Entry")
Select Case confirm
Case Is = vbYes
Dim Cell As Range
With ActiveSheet
.Unprotect Password:="peteamy"
.Cells.Locked = False
For Each Cell In ActiveSheet.UsedRange
If Cell.Value = "" Then
Cell.Locked = False
Else
Cell.Locked = True
End If
Next Cell
.Protect Password:="peteamy"
End With
Case Is = vbNo
Application.Undo
End Select
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myrange As Range, lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B2:B" & lr)
For Each Cell In myrange
If Cell.Value <> "" And Cell.Offset(0, 2).Value = "" Then
MsgBox "Your ID Number is Required"
Application.EnableEvents = False
Cell.Offset(0, 2).Select
Application.EnableEvents = True
Exit Sub
End If
Next Cell
End Sub