CODEWITHSUNDEEP
excelvba
hsquared
hsquared

Reputation: 359

Updating sheet automatically when a change is made - VBA Excel

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!

Upvotes: 1

Views: 2565

Answers (4)

Pᴇʜ
Pᴇʜ

Reputation: 57673

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

Upvotes: 0

Gexas
Gexas

Reputation: 678

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

Upvotes: 1

Sphinx
Sphinx

Reputation: 660

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

Upvotes: 1

Xabier
Xabier

Reputation: 7735

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

Upvotes: 3

Related Questions