Delete entire row if cell in column "I" empty

[Littleme]

Hi everyone!

Am new to this forum and am really hoping you can help me... this seemingly simple problem has got me totally stumped.

What I want to do is delete entire rows in the Table called "Databas" if cell in column "I" is empty. That's it. Copied code from ron de bruin but keep getting run time error 1004.

Driving me crazy!

Very grateful if someone could take a look at the file and help... maybe I'll be able to sleep =)

Sub Delete_with_Autofilter()
  Dim DeleteValue As String
  Dim rng As Range
  Dim calcmode As Long

  With Application
  calcmode = .Calculation
  .Calculation = xlCalculationManual
  .ScreenUpdating = False
  End With

  'Fill in the value that you want to delete
  'Tip: use DeleteValue = "<>ron" to delete rows without ron
  DeleteValue = ""

  'Sheet with the data, you can also use Sheets("MySheet")
  With ActiveSheet

  'Firstly, remove the AutoFilter
  .AutoFilterMode = False

  'Apply the filter
  .Range("A1:k" & .Rows.Count).AutoFilter Field:=9, Criteria1:=DeleteValue

  With .AutoFilter.Range
  On Error Resume Next
  Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
  .SpecialCells(xlCellTypeVisible)
  On Error GoTo 0
  If Not rng Is Nothing Then rng.EntireRow.Delete
  End With

  'Remove the AutoFilter
  .AutoFilterMode = False
  End With

  With Application
  .ScreenUpdating = True
  .Calculation = calcmode
  End With

End Sub

 

[Luke M]

I think Ron's code is built for something more complicated. Try this:

Sub QuickDelete()
Dim myRange As Range
Dim tbRange As Range

With ActiveSheet
    'Find where the table sits
    Set tbRange = .ListObjects(1).DataBodyRange
    On Error Resume Next
    'Check for blank cells in col I
    Set myRange = Intersect(tbRange, .Range("I:I")).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    'Check if no blank cells found
    If myRange Is Nothing Then
        MsgBox "No blank cells found"
    Else
        'Delete the blank cells' rows from table
        Intersect(tbRange, myRange.EntireRow).Delete
    End If
End With
End Sub

 

[Littleme]

What a quick response!
Will try it tomorrow and get back to you

 

[Littleme]

I love you! Perfect!!

 

[prasuna]

Hi,
i have duplicate id's.
in each id i want to copy only first row.then paste in different sheet.
can you please give reply for this one

 

[Luke M]

Hi Prasuna,
Please to not tack on (hijack) an existing thread. If you have a question, you should start your own thread so that others will see it and know that there is no answer yet.