spyfly
04-10-2024, 03:02 PM
Hi there! I am trying to create a script where when I select a value in a cell (column D) from a dropdown, then the cell next to it in column E, will populate with the selection, the current user, and the date time. It works except for when you autofill or copy paste the value. In order to address that, I created a script that should check if column D is populated and if column E is not, then then it should be filled. This only works after I manually initiate the function. I need it to work as soon as you open excel. Here is the entire script. I have been stuck on this problem all day and I just can't think clearly about it anymore. Any help is greatly appreciated.
Sub FillMissingInColumnE()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim newValue As String
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
For i = 1 To lastRow
If ws.Cells(i, "D").Value <> "" And ws.Cells(i, "E").Value = "" Then
newValue = ws.Cells(i, "D").Value & " | " & ws.Cells(i, "D").Value & _
" by " & Environ("username") & " on " & _
Format(Now, "yyyy-mm-dd HH:mm:ss")
ws.Cells(i, "E").Value = newValue
End If
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim AffectedCells As Range
Dim IntersectRange As Range
Set IntersectRange = Intersect(Target, Me.Columns("D"))
If Not IntersectRange Is Nothing Then
For Each Cell In IntersectRange
If Len(Cell.Value) > 0 Then
Set AffectedCells = Cell.Offset(0, 1)
AffectedCells.Value = AffectedCells.Value & " | " & Cell.Value & " by " & _
Environ("username") & " on " & _
Format(Now, "yyyy-mm-dd HH:mm:ss")
End If
Next Cell
FillMissingInColumnE
End If
Application.EnableEvents = True
End Sub
Sub FillMissingInColumnE()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim newValue As String
Set ws = ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
For i = 1 To lastRow
If ws.Cells(i, "D").Value <> "" And ws.Cells(i, "E").Value = "" Then
newValue = ws.Cells(i, "D").Value & " | " & ws.Cells(i, "D").Value & _
" by " & Environ("username") & " on " & _
Format(Now, "yyyy-mm-dd HH:mm:ss")
ws.Cells(i, "E").Value = newValue
End If
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim AffectedCells As Range
Dim IntersectRange As Range
Set IntersectRange = Intersect(Target, Me.Columns("D"))
If Not IntersectRange Is Nothing Then
For Each Cell In IntersectRange
If Len(Cell.Value) > 0 Then
Set AffectedCells = Cell.Offset(0, 1)
AffectedCells.Value = AffectedCells.Value & " | " & Cell.Value & " by " & _
Environ("username") & " on " & _
Format(Now, "yyyy-mm-dd HH:mm:ss")
End If
Next Cell
FillMissingInColumnE
End If
Application.EnableEvents = True
End Sub