OzGrid

Sub LessThanFortyOneDPDRemove()

 

Dim sht1 As Worksheets                  'Worksheet Master'
Dim DPD As String                          'Days Past Due'
Dim c1row As Long                         'starting row'
Dim c1TotalRows As Long                 'total rows'
Dim DPDremoved As Long                  'total removed'

 

'Searches through a sheet looking for all accounts that are less than 41 days past due'
'and deletes them'

Set sht1 = Worksheets("Master")

sht1.Activate

c1TotalRows = Application.CountA(Range("A:A"))

c1row = 2

 Do While sht1.Cells(c1row, 2).Value <> ""

DPD = sht1.Cells(c1row, 2).Value

    For c2row = 2 To c1TotalRows

        If DPD < 41 Then

            sht1.Activate
            Rows(c1row).Delete
            DPDremoved = DPDremoved + 1
            c1row = c1row - 1
            sht1.Activate
            Exit For

        End If

    Next
   
    c1row = c1row + 1

 Loop

MsgBox DPDremoved & " accounts less than 41 dpd removed."
 
End Sub

Option Explicit

Sub Less41()
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr As Long, lc As Long
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    lc = s1.Cells(1, Columns.Count).End(xlToLeft).Column
    s1.Range(Cells(1, 1), Cells(lr, lc)).AutoFilter Field:=2, Criteria1:=">41", _
                                                    Operator:=xlAnd
    s1.Range("A1").CurrentRegion.Copy
    s2.Range("A1").PasteSpecial xlPasteValues
End Sub