Deleting Rows

[markbarr]

Guys

whats the quickest way of deleting rows that are greater than a specified date

I have a column (H) that has a date in it

there are 750 rows.

I need to check each row and if the date in col H is greater than or equals to a specified date then the entire row is deleted.

I have tried the standard select the row if >= and then entire.row.delete but it takes over 2 minutes for only 750 records and it doesnt delete all the rows that are greater than the date

this is the code I have tried

MyCount = Application.CountA(Worksheets("Tempdata").Range("C:C"))
r = MyCount
v = CDate(Worksheets("Change").Range("A4").Value)
For s = 2 To r
t = CDate(Worksheets("Tempdata").Range("I" & s).Value)
If t >= v Then
Worksheets("Tempdata").Rows(s).Select
Worksheets("Tempdata").Rows(s).EntireRow.Delete
End If
Next s



Any ideas

Mark

 

[MARK858]

I'll just create a new sheet...
The code is set for your dates to be in Column I of sheet Tempdata (please note the code as it stands will error out if there are no dates equal or greater than November 1st 2013).

Sub NOLOOP2()
    Dim i As String, lr As Long, lc As Long, t As Double
    
    t = Timer
    lr = Sheets("Tempdata").Range("I" & Rows.Count).End(xlUp).Row
    lc = Sheets("Tempdata").Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
    Application.ScreenUpdating = 0
    
    On Error Resume Next
    If ThisWorkbook.Sheets("NovSht") Is Nothing Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets("Tempdata")).Name = "NovSht"
    End If
    On Error GoTo 0
    
    Sheets("NovSht").Rows(1).Value = Sheets("Tempdata").Rows(1).Value
    
    i = "11/1/2013"    'please note this is correct for 1st November as VBA is in US format by default
    
    With Sheets("Tempdata")
        With .Range(.Cells(1, 1), .Cells(lr, lc))
            .AutoFilter field:=9, Criteria1:=">=" & i
            Application.DisplayAlerts = 0
            With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
                .Copy Sheets("NovSht").Range("A" & Rows.Count).End(xlUp).Offset(1)
                'copies data to next empty row
                'if you want it to start at a fixed A2 then change the line above to
                '.Copy Sheets("NovSht").Range("A2")
                .Delete
            End With
        End With
    End With
    Application.DisplayAlerts = 1

    With Sheets("Tempdata")
        .AutoFilterMode = 0
        On Error Resume Next
        .Range("I1:I" & .Range("I" & .Rows.Count).End(xlUp).Row).SpecialCells(4).EntireRow.Delete
        On Error GoTo 0
    End With
    
    Sheets("NovSht").Columns(9).AutoFit
    Application.ScreenUpdating = 1
    
    MsgBox "Code took " & Format(Timer - t, "0.00 secs")
End Sub

 

[markbarr]

H

Doesn't matter not created yet lets say Data and Overdue

Mark

 

[MARK858]

See post #21

I'll just create a new sheet...

 

[markbarr]

Hi

It crashes with the error

"AutoFilter Method of range class failed"

at the line

.AutoFilter field:=9, Criteria1:=">=" & i

Column I in Tempdata has 233 dates that are over 1/11/2013 or blank so i dont know whats wrong



Mark

 

[MARK858]

Is you data in column I in a different date format to your regional settings as the code works ok for me on the sample book you posted in the link (see link below)?

http://https://app.box.com/s/ew5au6u81sakj5f9il69

and did you have an autofilter already on? if yes turn it off.

 

[MARK858]

Once you get it working I forgot you wanted the blanks transferred over so change the code to the code below

Sub NOLOOP3()
    Dim i As String, lr As Long, lc As Long, t As Double

    t = Timer
    lr = Sheets("Tempdata").Range("I" & Rows.Count).End(xlUp).Row
    lc = Sheets("Tempdata").Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column
    Application.ScreenUpdating = 0

    On Error Resume Next
    If ThisWorkbook.Sheets("NovSht") Is Nothing Then
        ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets("Tempdata")).Name = "NovSht"
    End If
    On Error GoTo 0

    Sheets("NovSht").Rows(1).Value = Sheets("Tempdata").Rows(1).Value

    i = "11/1/2013"    'please note this is correct for 1st November as VBA is in US format by default

    With Sheets("Tempdata")
        .AutoFilterMode = False
        With .Range(.Cells(1, 1), .Cells(lr, lc))
            .AutoFilter Field:=9, Criteria1:=">=" & i, Operator:=xlOr, Criteria2:=Array("=")
            Application.DisplayAlerts = 0
            With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12)
                .Copy Sheets("NovSht").Range("A" & Rows.Count).End(xlUp).Offset(1)
                'copies data to next empty row
                'if you want it to start at a fixed A2 then change the line above to
                '.Copy Sheets("NovSht").Range("A2")
                .Delete
            End With
        End With
    End With
    Application.DisplayAlerts = 1

    With Sheets("Tempdata")
        .AutoFilterMode = 0
        On Error Resume Next
        .Range("I1:I" & .Range("I" & .Rows.Count).End(xlUp).Row).SpecialCells(4).EntireRow.Delete
        On Error GoTo 0
    End With

    Sheets("NovSht").Columns(9).AutoFit
    Application.ScreenUpdating = 1

    MsgBox "Code took " & Format(Timer - t, "0.00 secs")
End Sub

 

[markbarr]

Well done mark

Your sample splits it great will try and put it in my project now

one problem

it deletes all the rows that have a blank in them. These need to be in Nov sheet as they are jobs that haven't been completed yet

There are nine of them

if you add up whats in Tempdata (522) and NovSht(219) comes to 741

There should be 750 rows

Mark

 

[MARK858]

See post #26 (it does also allow for if you have the autofilter on)

 

[markbarr]

Mark

YOU ARE A STAR

put it into my main project and it does what it says on the tin and super fast

one last thing you set the date for the split in the code



i = "11/1/2013"

How can I change it to use a date in another sheet I have tried the following
i = Worksheets("Change").Range("A4").Value
This is where it is stored. it has the format 01/11/2013 00:00:00

but it doesn't work. As I said each month new data needs to be loaded so the split date needs to change each month and each year so January will be interesting

I cant have people change the code as users will load this new data in from a button on the ribbon bar so i need it to be entered on a sheet

Thank you so much for your help

Mark

 

[markbarr]

Mark

Its ok worked it out

i = Format(CDate(Worksheets("Change").Range("A4").Value), "mm/dd/yyyy")

does the trick

thanks for your help

Mark