CODEWITHSUNDEEP
vbaexcel
n00b
n00b

Reputation: 31

VBA Macro to delete rows to a default table size

I have a macro that will add lines as the second to bottom row of a table gets filled up but i want to add a second macro to resize the table to 12 rows and 11 columns when the table is over 12 rows and there is no data in the additional rows.

Here is the Macro to add rows:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    'Declaration of Variables
    Dim sht As Worksheet
    Dim LastRow As Long

    'Set sht as worksheet
    Set sht = ThisWorkbook.Worksheets("Sheet2")

    'Set Lastrow
    LastRow = sht.ListObjects("Table1").Range.Rows.Count
    LastRow = LastRow + 4

    'Check - is someone entering in account name for the last open row
    If Me.Range("B" & LastRow - 1) = "" Then 'User is not entering in account name in last open row, exit sub
        Exit Sub
    Else 'User is entering in account name in last open row - create new row
        Application.EnableEvents = False 'turn off event handlers which allows sub to execute
        Rows(LastRow).Select 'select the summary row
        Selection.EntireRow.Insert 'insert row above
        ActiveSheet.Range("F" & LastRow & ":L" & LastRow).Select 'select formulas only
        Selection.FillDown 'fill the formulas in
        ActiveSheet.Range("C" & LastRow - 1).Select 'on the row that is being entered, select Pipeline Stage Cell
        Application.EnableEvents = True 'turn on event handlers
    End If
End Sub

I found this macro online but I cant seem to manipulate it to do what I want, I want the macro to resize the table to 12 rows by 11 columns when L14 < 1 

Sub DeleteBlankRows1()
    'Deletes the entire row within the selection if the ENTIRE row contains no data.

    'We use Long in case they have over 32,767 rows selected.
    Dim i As Long

    'We turn off calculation and screenupdating to speed up the macro.
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False

    'We work backwards because we are deleting rows.
    For i = Selection.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
            Selection.Rows(i).EntireRow.Delete
        End If
    Next i
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Upvotes: 1

Views: 502

Answers (1)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9966

You may try something like this...

Sub DeleteTableRows()
Dim ws As Worksheet
Dim tbl As ListObject
Dim r As Long, c As Long
Set ws = Sheets("Sheet2")
Set tbl = ws.ListObjects("Table1")
For r = tbl.DataBodyRange.Rows.Count To 12 Step -1
    If Application.CountIf(tbl.DataBodyRange.Rows(r), "?*") = 0 Then
        tbl.ListRows(r).Delete
    End If
Next r
For c = tbl.DataBodyRange.Columns.Count To 12 Step -1
    tbl.ListColumns(c).Delete
Next c
End Sub

If you want to include an IF statement to check the table rows, you can try it like this...

Sub DeleteTableRows()
Dim ws As Worksheet
Dim tbl As ListObject
Dim r As Long, c As Long, tblRows As Long
Set ws = Sheets("Sheet2")
Set tbl = ws.ListObjects("Table1")
tblRows = tbl.DataBodyRange.Rows.Count
If tblRows > 12 Then
    For r = tbl.DataBodyRange.Rows.Count To 12 Step -1
        If Application.CountIf(tbl.DataBodyRange.Rows(r), "?*") = 0 Then
            tbl.ListRows(r).Delete
        End If
    Next r
    For c = tbl.DataBodyRange.Columns.Count To 12 Step -1
        tbl.ListColumns(c).Delete
    Next c
End If
End Sub

Upvotes: 1

Related Questions