I am creating macro which will loop through column F and will delete month april from 2013. It seem that the macro is deleting all :-D. I dont know how to set it to delete only my criteria I tried
(Month(Now) - 2). Mine date of format looks like
Thank you for your help.
Sub Test1() Dim rgFoundCell As Range Dim toBeDeted As Range Dim firstAddress With Sheets("Sheet1").Range("F:F") Set rgFoundCell = .Find(What:=(Month(Now) - 2)) If Not rgFoundCell Is Nothing Then firstAddress = rgFoundCell.Address Do If toBeDeted Is Nothing Then Set toBeDeted = rgFoundCell.EntireRow Else Set toBeDeted = Union(toBeDeted, rgFoundCell.EntireRow) End If Set rgFoundCell = .FindNext(rgFoundCell) If rgFoundCell Is Nothing Then Exit Do Loop While rgFoundCell.Address <> firstAddress End If End With Application.ScreenUpdating = True If Not toBeDeted Is Nothing Then _ toBeDeted.Delete ' Delete End Sub
You can’t use .Find in the way you think – it is only able to do text match or number match comparisons. This leaves you with having to cycle through each cell in the range and run your comparison explicitly on each cell
Sub Test1() Dim toBeDeleted As Range With Sheets("Sheet1").Range("F:F") For Each c In .Cells If Month(c.Value) = 3 And Year(c.Value) = 2013 Then If toBeDeleted Is Nothing Then Set toBeDeleted = c.EntireRow Else Set toBeDeleted = Union(toBeDeleted, c.EntireRow) End If End If Next End With If Not toBeDeleted Is Nothing Then _ toBeDeleted.Delete ' Delete End Sub
You might want to consider running the function on a more refined range than the full F column or use an end of data marker like checking for a blank row to stop the loop.
Sub Test1() On Error GoTo e Application.ScreenUpdating = False Dim rng As Range Dim firstAddress Set rng = Sheets("Sheet1").Range("F1", Sheets("Sheet1").Range("F1").End(xlDown)) Dim i As Long i = 1 While i <= rng.Count If Month(CDate(rng(i))) = 4 And Year(CDate(rng(i))) = 2014 Then rng (i).EntireRow.Delete Else i = i + 1 End If Wend x: Application.ScreenUpdating = True Exit Sub e: MsgBox (Err.Description) Resume x End Sub
Maybe try to reduce the F:F range!!!