VBA Add Date to Specific Cell Based on Contents of Another Cell

[welshraz]

Hello!

I have this code which works to put in the date when a cell in column B changes. This is fine, but I'd like to have one that inputs the date when the cells in column B say something specific.

Private Sub Worksheet_Change(ByVal Target As Range)
'BC dates
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
xOffsetColumn = 11
If Not WorkRng Is Nothing Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
            Rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

When column B = "Acknowledged" put date in column L
When column B = "In Progress" put date in column N
When column B = "Complete" put date in column O

Any help greatly appreciated!

 

[Peter_SSs]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim WorkRng As Range
  Dim Rng As Range
  Dim DateCol As String
  
  Set WorkRng = Intersect(Columns("B"), Target)
  If Not WorkRng Is Nothing Then
      Application.EnableEvents = False
      For Each Rng In WorkRng
          If Not VBA.IsEmpty(Rng.Value) Then
              Select Case UCase(Rng.Value)
                Case "ACKNOWLEDGED"
                  DateCol = "L"
                Case "IN PROGRESS"
                  DateCol = "N"
                Case "COMPLETE"
                  DateCol = "O"
              End Select
              If Len(DateCol) > 0 Then
                With Cells(Rng.Row, DateCol)
                  .Value = Now
                  .NumberFormat = "dd/mm/yyyy"
                End With
              End If
          Else
              Intersect(Rng.EntireRow, Union(Columns("L"), Columns("N:O"))).ClearContents
          End If
      Next
      Application.EnableEvents = True
  End If
End Sub

 

[Trebor76]

Hi welshraz,

Here's my attempt:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    'BC dates
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    
    Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
    
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            xOffsetColumn = Evaluate("IFERROR(VLOOKUP(""" & StrConv(Rng.Value, vbProperCase) & """,{""Acknowledged"",10;""In Progress"",12;""Complete"",13},2,0),0)")
            If xOffsetColumn > 0 Then
                Rng.Offset(0, xOffsetColumn).Value = Format(Now(), "dd/mm/yyyy")
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next Rng
        Application.EnableEvents = True
    End If
    
End Sub

Regards,

Robert

 

[Marc L]

Hello, for starters :​

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim C%
    With Target(1)
        If .Column = 2 Then
            Select Case .Text
                   Case "Acknowledged": C = 10
                   Case "In Progress":  C = 12
                   Case "Complete":     C = 13
            End Select
            If C Then
                Application.EnableEvents = False
               .Offset(, C).Value = Now
                Application.EnableEvents = True
            End If
        End If
    End With
End Sub

 

[welshraz]

Hi welshraz,

Here's my attempt:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    'BC dates
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
   
    Set WorkRng = Intersect(Application.ActiveSheet.Range("B:B"), Target)
   
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            xOffsetColumn = Evaluate("IFERROR(VLOOKUP(""" & StrConv(Rng.Value, vbProperCase) & """,{""Acknowledged"",10;""In Progress"",12;""Complete"",13},2,0),0)")
            If xOffsetColumn > 0 Then
                Rng.Offset(0, xOffsetColumn).Value = Format(Now(), "dd/mm/yyyy")
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next Rng
        Application.EnableEvents = True
    End If
   
End Sub

Regards,

Robert

This kind of works when I manually input data, but the status in column B is populated by a formula (just a basic vlookup) but the dates don't populate when the status changes. Apologies, I should have included that in my original post.

 

[welshraz]

This kind of works when I manually input data, but the status in column B is populated by a formula (just a basic vlookup) but the dates don't populate when the status changes. Apologies, I should have included that in my original post.

I should also add, that the tab that this macro is built into will not be selected when the status in column B changes. The data gets dumped into another tab which auto populates column B.

 

[Peter_SSs]

This kind of works when I manually input data, but the status in column B is populated by a formula (just a basic vlookup) but the dates don't populate when the status changes. Apologies, I should have included that in my original post.

That is the same for the code you posted in post 1 which you said worked.
The suggested code in post 3 also does not remove the date if the then column B cell is cleared like your original code did.

Questions.

1. If a particular cell in column B is already, say, "Complete" and there is a date in column O and you dump new data into the other sheet and this particular cell in column B still evaluates to "Complete" do you want the data in column O to remain what it was or update to today's date?
2. Can you confirm that if on recalculation a cell in column B changes from, say, "Complete" to something else that you would want the date removed from column O (and new date added to one of the other columns if the cell value is one of the values listed)?
3. What is the name of the sheet that gets the data dumped into? What is the name of the sheet where you want the dates?

 

[Trebor76]

Never mind. I was going to suggest just using formulas but then the date would always be the current date - unless it can be referenced from another cell (maybe there's a report date somewhere)?

 

[welshraz]

That is the same for the code you posted in post 1 which you said worked.
The suggested code in post 3 also does not remove the date if the then column B cell is cleared like your original code did.

Questions.

1. If a particular cell in column B is already, say, "Complete" and there is a date in column O and you dump new data into the other sheet and this particular cell in column B still evaluates to "Complete" do you want the data in column O to remain what it was or update to today's date?
2. Can you confirm that if on recalculation a cell in column B changes from, say, "Complete" to something else that you would want the date removed from column O (and new date added to one of the other columns if the cell value is one of the values listed)?
3. What is the name of the sheet that gets the data dumped into? What is the name of the sheet where you want the dates?

Yes, I was testing it by manually inputting the data but didn't think about it needing to be different if the cell was populated by a formula. I should have asked for a worksheet calculate rather than a worksheet change.

1. I would like the date to remain what it was and not update
2. I would like the date to remain in each column when the status changes
3. The data gets dumped into "Report Dump", and the dates should update on "BC Completes"

 

[Peter_SSs]

Given your answers above, I think that you will need to keep a record of the existing values in BC Updates column B each time. This could be in another worksheet or, as I have done here, used a column in the BC Updates sheet. I used column Z and this column could be hidden if you want.

Try this with a copy of your workbook.

1. On 'BC Updates', copy the whole of column B and Pate Special (Values) into column Z of that same sheet.
2. Put this Worksheet_Change event code in the 'Report Dump' worksheet module.
3. Dump a new lot of data into the 'Report Dump' sheet and check the results in columns L, N and O (& Z) of 'BC Updates'

I have assumed that columns L, N & O have already been formatted to the appropriate date format that you want.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Variant, b As Variant
  Dim i As Long
  Dim DateCol As String
 
  DoEvents
  With Sheets("BC Updates")
    With .Range("B1", .Range("B" & Rows.Count).End(xlUp))
      a = .Value
      b = Intersect(.EntireRow, .Parent.Columns("Z")).Value
      For i = 1 To UBound(a)
        If a(i, 1) <> b(i, 1) Then
          Select Case UCase(a(i, 1))
            Case "ACKNOWLEDGED": DateCol = "L"
            Case "IN PROGRESS": DateCol = "N"
            Case "COMPLETE": DateCol = "O"
            Case Else: DateCol = ""
          End Select
          If DateCol <> "" Then .Parent.Cells(i, DateCol).Value = Date
        End If
        b(i, 1) = a(i, 1)
      Next i
      Intersect(.EntireRow, .Parent.Columns("Z")).Value = b
    End With
  End With
End Sub