Search a sheet for a date then delete the row, repeat until the lastrow of the table.

[Richhall]

Hi,hope I can explain this right, if someone is able to help please.

I have a table of data, column B has some text in it, column H has
dates.

I want to go down the table for each row, to the last row (which may
vary in address) and check if a date in each row is over a month from
todays date, and if so delete the that row then move to the next.

I have a <TAGR> field which will always be after the last row if
genuine data, so I figured if I find this I could set the lastrow
number, but not sure how as I can only return the address. Can I use
Left or something on this value to get the number?

Cells.Find(What:="<TAGR>", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
lastrow = ActiveCell.Address(False, False)

So one I have worked out how to do this I figure if I go down column B
to check it isn't <TAGR> and if it isnt use ActiveCell.Offset to then
go to column H for that row and check the date. Again not sure how to
do this, I have attempted the logic, but as previously posted I don't
know about coding!

Range("B6").Select

mynow = Now()
mydate = Format(mynow, "dd/mm/yyyy")

For A = 1 To lastrow
If ActiveCell.Value = "<TAGR>" Then
Set A = lastrow
Next A
Else
ActiveCell.Offset(0, 6).Activate
'what do i put here?
Else: Selection.EntireRow.Delete
Next A

Cheers

Rich

 

[Kevin Smith]

Hello.

this should do what you are after.

Sub DateChecker()

Dim Lineindex As Integer
'Start at Row 2 - allowing for headings
Lineindex = 2
'Keep going until <TARG>
Do Until Range("B" & Lineindex) = "<TARG>"
'Date over 31 days old
If Range("H" & Lineindex) < Date - 31 Then
Range("A" & Lineindex).Select
ActiveCell.EntireRow.Delete
Else
Lineindex = Lineindex + 1
End If
Loop
Range("A1").Select

End Sub

 

[Luke M]

'In order to prevent confusion by deleting a row and then going down,
'because that would move an unsearched row into a spot we had
'just searched, it's better to start at the bottom. This macro should do
'what you're are trying to accomplish.

Sub FindAndDelete()

Application.ScreenUpdating = False

'Assuming you meant look for dates older than 1 month
x = DateSerial(Year(Date), Month(Date) - 1, Day(Date))

'Find the <TAGR> value
For Each Cell In Range("B:B")
If Cell.Value = "<TAGR>" Then
'Search until row right before <TAGR>
lastrow = Cell.Row - 1
Exit For
End If
Next Cell

'Start at bottom, work our way up
For A = lastrow To 1 Step -1
With Cells(A, "H")
If .Value <= x Then
.EntireRow.Delete
End If
End With
Next A

Application.ScreenUpdating = True

End Sub

 

[Richhall]

Thank you thats brilliant,cheers.