Multiple lines of VBA - vba

Question

Trying to use VBA to enter break time in a spreadsheet. 1st Break, Lunch, 2nd Break. I have three sets of code in vba but am only able to get the 1st break code to work other two do not give a result. I have attached the VBA Code. I am new to VBA as you can see.
Private Sub Worksheet_Calculate()
End Sub
Private Sub Worksheet1_Change(ByVal Target As Range)
'Break 1
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 15
xTimeColumn = 6
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub
Private Sub Worksheet2_Change(ByVal Target As Range)
'Lunch Break
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 16
xTimeColumn = 8
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub
Private Sub Worksheet3_Change(ByVal Target As Range)
'Break 2
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 17
xTimeColumn = 10
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub
There are three columns where time is entered, and three columns that a dropdown has the reference to run formula.

Answer 1

Further to #Scott Craner’s advice, you could do a nested IF solution – but with all your currentIF Else End If conditions in your existing code, I think it would become too difficult to maintain. Another possibility is to use a Select Case approach, and the code below uses that instead. I tested it and it seems to give you what you want.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
Application.EnableEvents = False
Dim xCellColumn As Integer, xTimeColumn As Integer
Dim xRow As Integer, xCol As Integer
Dim xDPRg As Range, xRg As Range
If Not Intersect(Range("O:Q"), Target) Is Nothing Then
xCellColumn = Target.Column
Select Case xCellColumn
Case Is = 15
xTimeColumn = 6
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
Case Is = 16
xTimeColumn = 8
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
Case Is = 17
xTimeColumn = 10
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Select
End If
Continue:
Application.EnableEvents = True
Exit Sub
GetOut:
MsgBox Err.Description
Resume Continue
End Sub