Delete entirerow if cellvalue in column A has "xxxx" as year

Eyeson15

Board Regular
Joined
Apr 30, 2015
Messages
201
Please take me out of my misery.
I think I'm going insane from google search overload.

I have a workbook with 5000+ entries. It has dates in the format (dd.mm.yy) in Column A.

All I need to do is delete ALL the rows that are not between 2005 and 2010 (inclusive both years)

For example:

(1) 22.02.14
(2) 01.01.07
(3) 02.12.01

So, Rows 1 and 3 would be deleted and 01.01.07 is kept because it is between 2005 and 2010.

Please help me, I got over 6 workbooks to do this and really can't do this manually.

Below is the code I sort of made. Doesn't work ofcourse but brilliant code for crashing computers.

James

Code:
Sub DeleteRows()
    
    Dim i As Long
    Dim st As Long
    Dim en As Long
    Dim test As Long

    'Set ranges to four digit year code'
    st = 2005
    en = 2010

    For i = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    
    test = Val(WorksheetFunction.Text(ActiveSheet.Range("A" & i).Value, "yyyy"))
    If test < st Or test > en Then
    ActiveSheet.Range("A" & i).EntireRow.Delete
    End If
    Next i
    
End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
this seems to work for me

Code:
Sub DeleteRows()
    
    Application.ScreenUpdating = False
    Dim i As Long
    
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
           
    If Year(Range("A" & i)) < "2005" Then
    
    ActiveSheet.Range("A" & i).EntireRow.Delete
    
    End If
   
      
    If Year(Range("A" & i)) > "2010" Then
    
    ActiveSheet.Range("A" & i).EntireRow.Delete
    
    End If
        
        
    Next i
  
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
See if this works for you:
Code:
Sub DeleteRows()
    
    Dim cll As Range
    Dim Rng2Del As Range

    'Set ranges to four digit year code'
    Const st = 2005
    Const en = 2010

    Application.ScreenUpdating = False
    For Each cll In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If (Year(cll.Value) < st) Or (Year(cll.Value) > en) Then
            If Rng2Del Is Nothing Then
                Set Rng2Del = cll
            Else
                Set Rng2Del = Application.Union(Rng2Del, cll)
            End If
        End If
    Next cll
    Rng2Del.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
See if this works for you:

Thanks i understand the or option from your code

my condensed code is

Code:
Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim i As Long
    For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Year(Range("A" & i)) < "2005" Or Year(Range("A" & i)) > "2010" Then
    ActiveSheet.Range("A" & i).EntireRow.Delete
    End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
See if this works for you:
Code:
Sub DeleteRows()
    
    Dim cll As Range
    Dim Rng2Del As Range

    'Set ranges to four digit year code'
    Const st = 2005
    Const en = 2010

    Application.ScreenUpdating = False
    For Each cll In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If (Year(cll.Value) < st) Or (Year(cll.Value) > en) Then
            If Rng2Del Is Nothing Then
                Set Rng2Del = cll
            Else
                Set Rng2Del = Application.Union(Rng2Del, cll)
            End If
        End If
    Next cll
    Rng2Del.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub


Thank you for your reply.

There is a debug error on line "If (Year(cll.Value) < st) Or (Year(cll.Value) > en) Then" it says type mismatch?
 
Upvote 0
Hello there Akatrouble,

I have tried your updated code.

There is a mismatch debug error on line "If Year(Range("A" & i)) < "2005" Or Year(Range("A" & i)) > "2010" Then"

Thank you
 
Last edited:
Upvote 0
@AkaTrouble:

One more thing: your code deletes non-conforming rows one by one; mine deletes them all at once -- much faster.
 
Upvote 0
The dates are in custom format "dd.mm.yy". Definetely not text
You have text strings, not real Excel dates.

Try this:
Code:
Sub DeleteRows()
    
    Dim cll As Range
    Dim Rng2Del As Range

    Const st = 5
    Const en = 10

    Application.ScreenUpdating = False
    For Each cll In Range("A1", Range("A" & Rows.Count).End(xlUp))
        If (CByte(Right(cll.Value, 2)) < st) Or (CByte(Right(cll.Value, 2)) > en) Then
            If Rng2Del Is Nothing Then
                Set Rng2Del = cll
            Else
                Set Rng2Del = Application.Union(Rng2Del, cll)
            End If
        End If
    Next cll
    Rng2Del.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,140
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top