J
JAbels001
I need help writing a VBA code for 2007 Excel. I have a document that
multiple people have access to. Within this document there are dates and data
next to those dates. I need all dates deleted upon being opened if it's
greater than 6mos from the date that it is opened. The dates are in columns
E, H and K and the data for each date is directly to the right (F, I and L).
The information goes all the way down from row 5 to row 450. I hope this
makes sense. This is what I got so far, but it only worked the first time I
opened the workbook. Every time thereafter it does not delete older than 6mos
dates.
Private Sub Workbook_Open()
Dim myWS As Worksheet
Dim myRange As Range
Dim anyCell As Range
Dim testDate As Date
Set myWS = ThisWorkbook.Worksheets("Sheet1")
testDate = Now() + 180
Set myRange = myWS.Range("E5:E450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
Set myRange = myWS.Range("H5:H450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
Set myRange = myWS.Range("K5:K450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
'housekeeping
Set myRange = Nothing
Set myWS = Nothing
End Sub
multiple people have access to. Within this document there are dates and data
next to those dates. I need all dates deleted upon being opened if it's
greater than 6mos from the date that it is opened. The dates are in columns
E, H and K and the data for each date is directly to the right (F, I and L).
The information goes all the way down from row 5 to row 450. I hope this
makes sense. This is what I got so far, but it only worked the first time I
opened the workbook. Every time thereafter it does not delete older than 6mos
dates.
Private Sub Workbook_Open()
Dim myWS As Worksheet
Dim myRange As Range
Dim anyCell As Range
Dim testDate As Date
Set myWS = ThisWorkbook.Worksheets("Sheet1")
testDate = Now() + 180
Set myRange = myWS.Range("E5:E450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
Set myRange = myWS.Range("H5:H450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
Set myRange = myWS.Range("K5:K450")
For Each anyCell In myRange
If anyCell > testDate Then
anyCell.ClearContents
anyCell.Offset(0, 1).ClearContents
End If
Next
'housekeeping
Set myRange = Nothing
Set myWS = Nothing
End Sub