Hello, I'm trying to combine two pieces of code and have been getting error messages. Below is the code I am trying to use. I have also attached a picture of the worksheet. Appreciate any help you might have!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("H3")) Is Nothing Then
' Change "E3" to the cell the user completes the year in
Const tlbName = "Table3" 'update to name of table name on relevant sheet
Dim DateCol
Dim MinYear
Dim MaxYear
DateCol = "H:H" 'change to match your date column
MinYear = Year(WorksheetFunction.Min(ActiveSheet.Range(DateCol)))
MaxYear = Year(WorksheetFunction.Max(ActiveSheet.Range(DateCol)))
With ActiveSheet
If Target.Value >= MinYear And Target.Value <= MaxYear Then
.ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1, Criteria1:="TRUE"
Else
.ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1
End If
End With
End If
End Sub
Sub GetListObjectNames()
Dim ws As Worksheet
Dim lo As ListObject
Dim rng As Range
Set ws = ActiveSheet
For Each lo In ws.ListObjects
Debug.Print lo.Name
MsgBox lo.Name
Next lo
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20180830
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 20
xTimeColumn = 19
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("H3")) Is Nothing Then
' Change "E3" to the cell the user completes the year in
Const tlbName = "Table3" 'update to name of table name on relevant sheet
Dim DateCol
Dim MinYear
Dim MaxYear
DateCol = "H:H" 'change to match your date column
MinYear = Year(WorksheetFunction.Min(ActiveSheet.Range(DateCol)))
MaxYear = Year(WorksheetFunction.Max(ActiveSheet.Range(DateCol)))
With ActiveSheet
If Target.Value >= MinYear And Target.Value <= MaxYear Then
.ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1, Criteria1:="TRUE"
Else
.ListObjects(tlbName).Range.Columns(1).AutoFilter Field:=1
End If
End With
End If
End Sub
Sub GetListObjectNames()
Dim ws As Worksheet
Dim lo As ListObject
Dim rng As Range
Set ws = ActiveSheet
For Each lo In ws.ListObjects
Debug.Print lo.Name
MsgBox lo.Name
Next lo
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20180830
Dim xCellColumn As Integer
Dim xTimeColumn As Integer
Dim xRow, xCol As Integer
Dim xDPRg, xRg As Range
xCellColumn = 20
xTimeColumn = 19
xRow = Target.Row
xCol = Target.Column
If Target.Text <> "" Then
If xCol = xCellColumn Then
Cells(xRow, xTimeColumn) = Now()
Else
On Error Resume Next
Set xDPRg = Target.Dependents
For Each xRg In xDPRg
If xRg.Column = xCellColumn Then
Cells(xRg.Row, xTimeColumn) = Now()
End If
Next
End If
End If
End Sub