Macro to Delete Blank Rows in Table

[skf786]

Hello,

my table headers are in c30:k30 and i am using a macro to paste data in the table. I am looking to add additional code to the END of this macro that deletes rows in the table that are totally blank. Cannot delete full rows of the sheet as there is more data outside the table.



thank you

KF

 

[Shanghai3]

Dear skf786,

Here is the solution.

I hope this helps. The macro asks to select the required range as well.

Regards,

Shanghai3

Option Explicit

Sub rowdeleter()
Dim ourrange As Range
Dim ourrow As Double


Set ourrange = Application.InputBox(prompt:="Please select the required range!", Type:=8)

For ourrow = ourrange.Row + ourrange.Rows.Count - 1 To ourrange.Row Step -1
        If Application.WorksheetFunction.CountA(Rows(ourrow)) = 0 Then Rows(ourrow).EntireRow.Delete
Next ourrow

End Sub

 

[skf786]

Dear skf786,

Here is the solution.

I hope this helps. The macro asks to select the required range as well.

Regards,

Shanghai3

Option Explicit

Sub rowdeleter()
Dim ourrange As Range
Dim ourrow As Double


Set ourrange = Application.InputBox(prompt:="Please select the required range!", Type:=8)

For ourrow = ourrange.Row + ourrange.Rows.Count - 1 To ourrange.Row Step -1
        If Application.WorksheetFunction.CountA(Rows(ourrow)) = 0 Then Rows(ourrow).EntireRow.Delete
Next ourrow

End Sub

Dear Shanghai3,

many thanks for your help. I would actually prefer if the macro applied the 'delete blank rows' on its own to the full table in the sheet named 10 instead of asking for a range.

Also the code has to be fitted into the existing code.

thank you

 

[JoeMo]

This should be easy to integrate with the existing code.

Sub DeleteEmptyTableRows()
Dim LO As ListObject, Rw As Range, Remov As Range
Set LO = ActiveSheet.ListObjects("Table1")  'Change table name to suit
If Application.CountA(LO.DataBodyRange) = 0 Then Exit Sub
For Each Rw In LO.DataBodyRange.Rows
    If Application.CountA(Rw) = 0 Then
        If Remov Is Nothing Then
            Set Remov = Rw
        Else
            Set Remov = Union(Remov, Rw)
        End If
    End If
Next Rw
Remov.Delete shift:=xlUp
End Sub

 

[skf786]

This should be easy to integrate with the existing code.

Sub DeleteEmptyTableRows()
Dim LO As ListObject, Rw As Range, Remov As Range
Set LO = ActiveSheet.ListObjects("Table1")  'Change table name to suit
If Application.CountA(LO.DataBodyRange) = 0 Then Exit Sub
For Each Rw In LO.DataBodyRange.Rows
    If Application.CountA(Rw) = 0 Then
        If Remov Is Nothing Then
            Set Remov = Rw
        Else
            Set Remov = Union(Remov, Rw)
        End If
    End If
Next Rw
Remov.Delete shift:=xlUp
End Sub

thank you Joe, this works perfectly.

Have a nice day.

 

[JoeMo]

thank you Joe, this works perfectly.

Have a nice day.

You are welcome - thanks for the reply.

 

[skf786]

This should be easy to integrate with the existing code.

Sub DeleteEmptyTableRows()
Dim LO As ListObject, Rw As Range, Remov As Range
Set LO = ActiveSheet.ListObjects("Table1")  'Change table name to suit
If Application.CountA(LO.DataBodyRange) = 0 Then Exit Sub
For Each Rw In LO.DataBodyRange.Rows
    If Application.CountA(Rw) = 0 Then
        If Remov Is Nothing Then
            Set Remov = Rw
        Else
            Set Remov = Union(Remov, Rw)
        End If
    End If
Next Rw
Remov.Delete shift:=xlUp
End Sub

Hi Joe,

can you please help in placing this code into my existing macro (attached).

thank you,

SKF

Sub PostEntry()
'
' PostEntry Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'

Application.ScreenUpdating = False

With ActiveSheet
      .Unprotect "7860"



    Range("D10:P13").Select
    Selection.Copy
    Range("D32").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("g10:g10").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Range("g7:g7").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    
    Range("j10:o13").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3


Range("D21:P24").Select
    Selection.Copy
    Range("D32").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F21:O24").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3


Range("E33").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range(Selection, Selection.End(xlDown)).Select
    Range("Table20[[#Headers],[Trxn Ref]]").Select

Range("P3").Select
    ActiveCell.FormulaR1C1 = "3"





  Range("d3").Select

      
      
Dim iCounter As Long
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    For iCounter = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
            Selection.Rows(iCounter).EntireRow.Delete
        End If
    Next iCounter
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With


    .Protect "7860"

End With

    
    



End Sub

 

[JoeMo]

Add the sub to your module, then call it from the appropriate place in the PostEntry procedure like this

Call DeleteEmptyTableRows

You could also make the table name an argument like this: Call DeleteEmptyTableRows(LOName) if the table name is dynamic.

Where (which line) in the PostEntry procedure do you want to delete empty table rows?

 

[skf786]

Add the sub to your module, then call it from the appropriate place in the PostEntry procedure like this

Call DeleteEmptyTableRows

You could also make the table name an argument like this: Call DeleteEmptyTableRows(LOName) if the table name is dynamic.

Where (which line) in the PostEntry procedure do you want to delete empty table rows?

Dear Joe, considering my very limited knowhow of VBA, i used the attached code and got the following error:

Sub PostEntry()
'
' PostEntry Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'

Application.ScreenUpdating = False

With ActiveSheet
.Unprotect "7860"



Range("D9:P12").Select
Selection.Copy
Range("D32").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("g9:g9").Select
Application.CutCopyMode = False
Selection.ClearContents

Range("g6:g6").Select
Application.CutCopyMode = False
Selection.ClearContents


Range("j912").Select
Application.CutCopyMode = False
Selection.ClearContents

ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3


Range("D20:P23").Select
Selection.Copy
Range("D32").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F20:O23").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3


Range("E32").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range(Selection, Selection.End(xlDown)).Select
Range("Table20[[#Headers],[Trxn Ref]]").Select






Range("d4").Select

Call DeleteEmptyTableRows

.Protect "7860"

End With



End Sub












Sub DeleteEmptyTableRows()
Dim LO As ListObject, Rw As Range, Remov As Range
Set LO = ActiveSheet.ListObjects("Table20") 'Change table name to suit
If Application.CountA(LO.DataBodyRange) = 0 Then Exit Sub
For Each Rw In LO.DataBodyRange.Rows
If Application.CountA(Rw) = 0 Then
If Remov Is Nothing Then
Set Remov = Rw
Else
Set Remov = Union(Remov, Rw)
End If
End If
Next Rw
Remov.Delete shift:=xlUp
End Sub

 

[skf786]

i ran the delete rows macro separately (not with my other code and found this error.