Updating sheet automatically when a change is made - VBA 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!

Why don't you do this with a formula? There is no need for VBA at all. In C2 just use something like =MAX(D2:F2) and pull the formula down. Or if you want to add years to the maxdate use =DATE(YEAR(MAX(D2:F2))+3,MONTH(MAX(D2:F2)),DAY(MAX(D2:F2))). Formulas are Excel's strength and should be faster anyway. — Pᴇʜ
– Pᴇʜ, Commented Nov 6, 2018 at 9:52
Any good reason why? It's just more complicated and I see no advantage. — Pᴇʜ
– Pᴇʜ, Commented Nov 6, 2018 at 10:25
Yes. I would also like to know if this is possible with VBA - is it not possible then? — hsquared
– hsquared, Commented Nov 6, 2018 at 10:27
It should be possible, but is a lot more work and complicated, because you need to re-invent what Microsoft already implemented with formulas. — Pᴇʜ
– Pᴇʜ, Commented Nov 6, 2018 at 10:30

Xabier · Accepted Answer · 2018-11-06 10:50:35Z

3

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

answered Nov 6, 2018 at 10:50

Xabier

7,7251 gold badge11 silver badges21 bronze badges

Sign up to request clarification or add additional context in comments.

3 Comments

Pᴇʜ Over a year ago

Just a Note: This could possibly fail. Eg. if you paste values by pasting a range, because Target.Column then returns the column number of the first column in that range. So if the pasted range is eg A2:H2 then Target.Column = 1 and it will not trigger your code even if values in columns 4,5,6 were changed/pasted. If you want to make it save against pasting you must do something with If Not Intersect(Target, Target.Parent.Range("D:F")) Is Nothing Then and then For Each Row in Target calculate Max_date etc.

Xabier Over a year ago

@PEH I never cease to learn something new from you, thanks for the note, will update my answer in a short while. :)

Pᴇʜ Over a year ago

I didn't mean that it is absolutely necessary but it depends more on how users input data in that worksheet. If they are used to copy paste a bunch of data it's better to be prepared. That's actually why I insisted in using a formula instead, because I saw this issue coming. Nevertheless, I posted an example here.

Sphinx · Accepted Answer · 2018-11-06 11:02:20Z

1

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

answered Nov 6, 2018 at 11:02

Sphinx

6601 gold badge7 silver badges15 bronze badges

Comments

Gexas · Accepted Answer · 2018-11-06 13:44:42Z

1

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

edited Nov 6, 2018 at 13:44

answered Nov 6, 2018 at 11:03

Gexas

6885 silver badges20 bronze badges

1 Comment

Pᴇʜ Over a year ago

Please note that if you declare Dim xRow, xCol As Long you only declare xCol As Long but xRow As Variant. In VBA you must declare a type for every variable: Dim xRow As Long, xCol As Long.

Pᴇʜ · Accepted Answer · 2018-11-06 15:25:47Z

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

Collectives™ on Stack Overflow

Updating sheet automatically when a change is made - VBA Excel

4 Answers 4

3 Comments

Comments

1 Comment

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

3 Comments

Comments

1 Comment

Comments

Your Answer

Sign up or log in

Post as a guest

Related