Updating sheet automatically when a change is made - VBA Excel - excel

Question

I struggling to work out the logic to this so any help would be appreciated!
I have a sheet with names and dates, on each row (in the example column D to F) it needs to find the greatest date and then add a date to a column (column C). I can get this to work on a single test row, but I need it to work when there is a change on any row.
B C D E F
Name Due Date Date 1 Date 2 Date 3
Dave 01-01-20 01-01-14 01-01-17
Sarah 01-01-21 01-02-11 01-02-15 01-02-18
The code I have so far is:
LastRow = wsCB.Cells(Rows.Count, "C").End(xlUp).Row
rowcount = 12
Max_date = Application.WorksheetFunction.Max(wsCB.Range(wsCB.Cells(rowcount, 5), wsCB.Cells(rowcount, 10)))
Max_date = CDate(Max_date)
DueDate = DateAdd("yyyy", 3, Max_date)
wsCB.Cells(12, 4) = DueDate
I have set it to call on a Worksheet_Change. I have tried various loops trying to use xlup but I'm not sure this is the right way to go about it as I need the value to be updated when the user has typed in a new date for someone. I can't quite work out how to scale this single line example to the whole sheet.
The data won't be massive, however there will be 5 sheets like this with up to a maximum of 70 names on each sheet.
I'm still quite new to VBA so any advice would be very helpful!

Answer 1

The following VBA code should achieve your desired results:
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 4, 5, 6 'if user entered data in columns D to F
Max_date = Application.WorksheetFunction.Max(Range(Cells(Target.Row, 4), Cells(Target.Row, 6)))
'get the max value in row from column D to F (4 to 6)
Max_date = CDate(Max_date)
DueDate = DateAdd("yyyy", 3, Max_date)
Cells(Target.Row, 3) = DueDate
End Select
End Sub

Answer 2

Try this.
You'll just need to adjust columns to fit your needs
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MaxDate As Date, DueDate As Date
Dim CurRow As Long
Dim Ws As Worksheet
Set Ws = Target.Parent
CurRow = Target.Row
With Ws
MaxDate = CDate(Application.WorksheetFunction.Max(.Range(.Cells(CurRow, "D"),.Cells(CurRow, "F"))))
DueDate = DateAdd("yyyy", 3, MaxDate)
Application.EnableEvents = False
.Cells(CurRow, 3) = DueDate
Application.EnableEvents = True
End With
End Sub

Answer 3

My suggested code for your problem:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xCellColumnD As Long
Dim xCellColumnE As Long
Dim xCellColumnF As Long
Dim xDueColumn As Long
Dim xRow As Long, xCol As Long
xCellColumnD = 4
xCellColumnE = 5
xCellColumnF = 6
xDueColumn = 3
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumnD Or xCol = xCellColumnE Or xCol = xCellColumnF Then
Max_date = Application.WorksheetFunction.Max(Range(Cells(xRow, 4), Cells(xRow, 6)))
Max_date = CDate(Max_date)
DueDate = DateAdd("yyyy", 3, Max_date)
Cells(xRow, xDueColumn) = DueDate
End If
End If
End Sub

Answer 4

I suggest to use Intersect in combination with a loop over the Target range so you are a bit more save against pasting a whole range of values.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Target.Parent
If Not Intersect(Target, ws.Range("D:F")) Is Nothing Then
Dim MaxDate As Double
Dim DueDate As Variant
Dim iRow As Long
For iRow = Target.Row To Target.Row + Target.Rows.Count - 1
On Error Resume Next
MaxDate = Application.WorksheetFunction.Max(ws.Range(ws.Cells(iRow, "D"), ws.Cells(iRow, "F")))
If Err.Number <> 0 Then
DueDate = "#VALUE!"
ElseIf MaxDate = 0 Then
DueDate = vbNullString 'remove date if no dates
Else
DueDate = DateAdd("yyyy", 3, MaxDate)
End If
On Error GoTo 0
Application.EnableEvents = False 'prevents triggering change event again
ws.Cells(iRow, "C").Value = DueDate
Application.EnableEvents = True
Next iRow
End If
End Sub