![]() |
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 |
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 |
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 |
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 |
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