ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   VBA help PLEASE (https://www.excelbanter.com/excel-discussion-misc-queries/258816-vba-help-please.html)

JAbels001

VBA help PLEASE
 
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


Don Guillett[_2_]

VBA help PLEASE
 
Don't know why you are having problems but this simple macro tested.

Private Sub Workbook_Open()
With Sheets("Sheet26")
For Each c In .Range("f2:f22,i2:i22,l2:l22")
If c Date + 180 Then c.Offset(, 1).ClearContents
Next c
End With
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"JAbels001" wrote in message
...
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



Bob Phillips[_4_]

VBA help PLEASE
 
That looks fine, should work everytime, but you can significantly shorten it

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:E10, H5:H10, K5:K10")
For Each anyCell In myRange

If IsNumeric(anyCell.Value2) Then

If anyCell.Value2 testDate Then

anyCell.Resize(, 2).ClearContents
End If
End If
Next

'housekeeping
Set myRange = Nothing
Set myWS = Nothing
End Sub


--

HTH

Bob

"JAbels001" wrote in message
...
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




Per Jessen[_2_]

VBA help PLEASE
 
Hi

Try this:


Private Sub Workbook_Open()
Dim myWS As Worksheet
Dim myRange As Range
Dim anyCell As Range
Dim testDate As Date
Application.ScreenUpdating = False
Set myWS = ThisWorkbook.Worksheets("Sheet1")

testDate = Now() - 180

Set myRange = myWS.Range("E5:E450,H5:H450,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
Application.ScreenUpdating = True
End Sub


Regards,
Per

On 13 Mar., 16:11, JAbels001
wrote:
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



Don Guillett[_2_]

VBA help PLEASE
 
You wanted to clear the date and the offset so use this instead

If c Date + 180 Then c.resize(,2).ClearContents

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"Don Guillett" wrote in message
...
Don't know why you are having problems but this simple macro tested.

Private Sub Workbook_Open()
With Sheets("Sheet26")
For Each c In .Range("f2:f22,i2:i22,l2:l22")
If c Date + 180 Then c.Offset(, 1).ClearContents
Next c
End With
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"JAbels001" wrote in message
...
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




JAbels001

VBA help PLEASE
 
Thanks for all the feedback! I utilized Per Jensen and it worked like charm!
Tested it out twice! Thank you so much!

"Per Jessen" wrote:

Hi

Try this:


Private Sub Workbook_Open()
Dim myWS As Worksheet
Dim myRange As Range
Dim anyCell As Range
Dim testDate As Date
Application.ScreenUpdating = False
Set myWS = ThisWorkbook.Worksheets("Sheet1")

testDate = Now() - 180

Set myRange = myWS.Range("E5:E450,H5:H450,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
Application.ScreenUpdating = True
End Sub


Regards,
Per

On 13 Mar., 16:11, JAbels001
wrote:
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


.



All times are GMT +1. The time now is 12:04 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com