I have a piece of code that does exactly as I want it to do. Whenever a cell is updated in the column "Contacts 1 Made?"
it inputs the date and time into the 2 columns to the right. I want to expand the target range though to include 2 other columns that aren't adjoined. These column headers are;
I want to same basic principles to apply to these columns. Whenever a cell is updated in any of these columns I want it to do the same thing and input the date and time in the cells to the right.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = ActiveSheet.ListObjects("VAMP_P1___P2").ListColumns("Contact 1 Made?").Range
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Application.EnableEvents = False
If Target.Value <> "" Then
ActiveCell.Offset(0, 1).Value = Format(Now(), "dd/mm/yyyy")
ActiveCell.Offset(0, 2).Value = Format(Now(), "hh:mm")
Else
ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(0, 2).Value = ""
End If
End If
Application.EnableEvents = True
End Sub
I tried to update the keycell range using the intersect shown below but when it runs it debugs with Invalid procedure call or argument
Set KeyCells = Intersect(ActiveSheet.ListObjects("VAMP_P1___P2").ListColumns("Contact 1 Made?").Range, ActiveSheet.ListObjects("VAMP_P1___P2").ListColumns("Contact 2 Made?").Range)
Main
Private Sub Worksheet_Change(ByVal Target As Range)
Const TABLE_NAME As String = "VAMP_P1___P2"
Const DATE_COLUMN_OFFSET As Long = 1
Const DATE_FORMAT As String = "dd/mm/yyyy"
Const TIME_COLUMN_OFFSET As Long = 2
Const TIME_FORMAT As String = "hh:mm"
Dim Titles() As Variant: Titles = Array( _
"Contact 1 Made?", _
"Contact 2 Made?", _
"Contact 3 Made?", _
"Appointed")
Dim trg As Range
With Target
Dim rg As Range: CombineTableDataColumns rg, _
.Worksheet.ListObjects(TABLE_NAME), Titles
Set trg = Intersect(rg, .Cells)
End With
If trg Is Nothing Then Exit Sub
Dim TimeNow As Date: TimeNow = Now
Dim DateString As String: DateString = Format(TimeNow, DATE_FORMAT)
Dim TimeString As String: TimeString = Format(TimeNow, TIME_FORMAT)
Dim srg As Range, crg As Range, cell As Range
For Each cell In trg.Cells
If Len(CStr(cell.Value)) > 0 Then ' Stamp
BuildRange srg, cell
Else ' Clear
BuildRange crg, cell
End If
Next cell
Application.EnableEvents = False
' Stamp
If Not srg Is Nothing Then
With srg
.Offset(, DATE_COLUMN_OFFSET).Value = DateString
.Offset(, TIME_COLUMN_OFFSET).Value = TimeString
End With
End If
' Clear
If Not crg Is Nothing Then
With crg
Union(.Offset(, DATE_COLUMN_OFFSET), _
.Offset(, TIME_COLUMN_OFFSET)).ClearContents
End With
End If
Application.EnableEvents = True
End Sub
Help
Sub CombineTableDataColumns( _
ByRef rg As Range, _
ByVal tbl As ListObject, _
Titles() As Variant)
Dim crg As Range, Title As Variant
For Each Title In Titles
BuildRange rg, tbl.ListColumns(Title).DataBodyRange
Next Title
End Sub
Sub BuildRange( _
ByRef rgBuilt As Range, _
ByVal rgAdd As Range)
If rgBuilt Is Nothing Then
Set rgBuilt = rgAdd
Else
Set rgBuilt = Union(rgBuilt, rgAdd)
End If
End Sub