Macro to delete rows or fill them wiht N/A

[Cdworks]

Here is a link showing what I have so far. I need Blanks to be filled or removed in order to use autofilter:

http://screencast.com/t/ViLLHhLrb97a

I will also need a macro that deletes any info past a certain date.

 

[Ralajer]

The following will delete the entire row if the criteria is met. You will have to change the ranges to fit your needs. Be sure to test it on copy of your data first.

Sub DeleteEmptyRows()
    Dim rng As range
    
    Set rng = range(range("A2"), range("A65536").End(xlUp))

    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

Sub DeleteRowAfterDate()
    Dim rng As range, cell As range
    Dim delRng As range
    Dim dateCol As String
    Dim cutoffDate As Date

    dateCol = "B"
    
    cutoffDate = DateValue("05/31/2000")
    
    Set rng = range(range(dateCol & "2"), range(dateCol & "65536").End(xlUp))
    
    For Each cell In rng
        If IsDate(cell.Value) And cell.Value > cutoffDate Then
            If delRng Is Nothing Then
            Set delRng = cell
            Else
            Set delRng = Union(delRng, cell)
            End If
        End If
    Next cell
    delRng.EntireRow.Delete
End Sub

Sub DeleteRowBeforeDate()
    Dim rng As range, cell As range
    Dim delRng As range
    Dim dateCol As String
    Dim cutoffDate As Date

    dateCol = "B"
    
    cutoffDate = DateValue("05/31/2000")
    
    Set rng = range(range(dateCol & "2"), range(dateCol & "65536").End(xlUp))
    
    For Each cell In rng
        If IsDate(cell.Value) And cell.Value < cutoffDate Then
            If delRng Is Nothing Then
            Set delRng = cell
            Else
            Set delRng = Union(delRng, cell)
            End If
        End If
    Next cell
    delRng.EntireRow.Delete
End Sub

 

[Cdworks]

Thank you! That works Great! is there anyway to add a popup box to input the date for the range to delete After date?

 

[Ralajer]

Got the following from VoG on this thread http://www.mrexcel.com/forum/showthread.php?t=446016. Just add it to the sub to have a user input of the date.

Dim TheString As String, TheDate As Date
TheString = Application.InputBox("Enter A Date")
If IsDate(TheString) Then
    TheDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
    Exit Sub '//ADDED
End If

 

[Cdworks]

Thank you I got everything to work. but now I am getting this:

This is the code I have it is throwing out the highlighted as a fail.

Sub DeleteRowAfterDate()
    Dim rng As Range, cell As Range
    Dim delRng As Range
    Dim dateCol As String
    Dim cutoffDate As Date
    Dim TheString As String
 
TheString = Application.InputBox("Enter A Date")
 
If IsDate(TheString) Then
    cutoffDate = DateValue(TheString)
Else
    MsgBox "Invalid date"
 
End If
 
    dateCol = "B"
        Set rng = Range(Range(dateCol & "2"), Range(dateCol & "65536").End(xlUp))
 
    For Each cell In rng
        If IsDate(cell.Value) And cell.Value > cutoffDate Then
            If delRng Is Nothing Then
            Set delRng = cell
            Else
            Set delRng = Union(delRng, cell)
            End If
        End If
    Next cell
    delRng.EntireRow.Delete
 
End Sub

The only thing I can think of is maybe there is an issue cropping up about defining delRng maybe? or Cell

 

[Ralajer]

Has the code worked at all because without that line executing nothing will change on the sheet. I guess if there is nothing to delete it will error out. Try replacing that line with this

If Not delRng Is Nothing Then delRng.EntireRow.Delete

and let me know if you are stilling getting problems.

 

[Cdworks]

Still nothing. It isnt deleting anything now but i am not getting a debug.

 

[Ralajer]

What was the message that pops up when the code hits that line?

 

[Cdworks]

DOh! My Datecol was set to the wrong letter...

 

[Ralajer]

Here are some improvements that will prompt user for date column to check and reprompt for date if it is not valid. Allowing for the macro to be a little more versatile.

Sub DeleteRowAfterDate()
    Dim Rng As range, cell As range
    Dim delRng As range, dateRng As range
    Dim dateCol As Integer
    Dim cutoffDate As Date
    Dim theString As String
    
    On Error Resume Next        '// Error handling for canceling the range inputbox
    
    '// Prompt user for column containing the date range to check
    Do
        Set dateRng = Application.InputBox( _
                            Prompt:="Select a cell in the Date Column", _
                            Title:="Date Column Select", _
                            Type:=8)
        '// Exit Sub if nothing was selected or the Cancel 'x' button was selected
        If dateRng Is Nothing Then Exit Sub
        
    '// Reprompt if more than one column was selected
    Loop While dateRng.Columns.Count > 1
    
    On Error GoTo 0             '// Resume default error handling
    
    dateCol = dateRng.Column
    
    theString = Application.InputBox("Enter A Date")
    '// Cancel 'x' button was selected then exit sub
    If theString = "False" Then Exit Sub
    
    Do While Not IsDate(theString)
        theString = Application.InputBox("Date Invalid! Enter a Valid Date")
        '// Cancel 'x' button was selected then exit sub
        If theString = "False" Then Exit Sub
    Loop
    
    cutoffDate = DateValue(theString)
    
    Set Rng = range(Cells(2, dateCol), Cells(65535, dateCol).End(xlUp))
    
    For Each cell In Rng
        If IsDate(cell.Value) And cell.Value > cutoffDate Then
            If delRng Is Nothing Then
            Set delRng = cell
            Else
            Set delRng = Union(delRng, cell)
            End If
        End If
    Next cell
    If Not delRng Is Nothing Then delRng.EntireRow.Delete
End Sub