CODEWITHSUNDEEP
excelvba
Peter
Peter

Reputation: 65

Delete LastRow to LastRow

I have a worksheet were a user can enter the amount of rows that will be used (I have code that will expand or decrease a table size). When the amount of rows the user inputs is less then the current number of rows in the table, I want to delete all the rows that are not being used. I'm using LastRow for this at the moment. I have a LastRow at the beginning of the code and at the end, so I know perfectly well which rows I want to delete, but I can't get the macro right. I think the code should be something like the following:

LastRowFirst = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
LastRowNext = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row

Range("B" & LastRowFirst : "AA" & LastRowNext).Delete

The total code i'm using is the following:

    LastRowFirst = Worksheets("Ent. Description").Cells(Rows.Count, 3).End(xlUp).Row

Application.AutoCorrect.AutoFillFormulasInLists = True

    Dim targetSheet As Worksheet
    Dim targetSheetName As String
    targetSheetName = "Ent. Description"
    Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
   
    Dim newTableRows As Long
    Dim newTableRowsCellAdd As String
    newTableRowsCellAdd = "A1"
    newTableRows = targetSheet.Range(newTableRowsCellAdd).Value2

    Dim targetTable As ListObject
    Dim targetTableName As String
    targetTableName = "Table1"
    Set targetTable = targetSheet.ListObjects(targetTableName)

    Dim newTableRange As Range
    Set newTableRange = targetTable.Range.Resize(newTableRows + 1, targetTable.Range.Columns.Count)
    targetTable.Resize newTableRange
    
    Dim tableCell As Range
    Dim rowWithFormulas As Long
    rowWithFormulas = 1
    For Each tableCell In targetTable.ListRows(rowWithFormulas).Range
    
        If tableCell.HasFormula Then
        
            tableCell.Copy targetTable.ListColumns(tableCell.Column).DataBodyRange
        
        End If
    
    Next tableCell

    LastRowNext = Worksheets("ent. Description").Cells(Rows.Count, 3).End(xlUp).Row

If you have any further questions please let me know

Upvotes: 0

Views: 105

Answers (1)

Ricardo Diaz
Ricardo Diaz

Reputation: 5696

I added code for both clearing the range contents and deleting the entire rows.

I suggest that you use Option Explicit at the top of your modules.

Read the code's comments and choose one of the methods (clear or delete) no need of both

EDIT: Just changed the .clearcontents with .clear so formatting is also deleted

Public Sub ResizeTable()
    
    Application.AutoCorrect.AutoFillFormulasInLists = True

    Dim targetSheet As Worksheet
    Dim targetSheetName As String
    targetSheetName = "Ent. Description"
    Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
   
    Dim newTableRows As Long
    Dim newTableRowsCellAdd As String
    newTableRowsCellAdd = "A1"
    newTableRows = targetSheet.Range(newTableRowsCellAdd).Value2

    Dim targetTable As ListObject
    Dim targetTableName As String
    targetTableName = "Table1"
    Set targetTable = targetSheet.ListObjects(targetTableName)
    
    ' Find the table's last row before resizing
    Dim previousLastRow As Long
    previousLastRow = targetTable.HeaderRowRange.Row + targetTable.Range.Rows.Count - 1

    Dim newTableRange As Range
    Set newTableRange = targetTable.Range.Resize(newTableRows + 1, targetTable.Range.Columns.Count)
    targetTable.Resize newTableRange
    
    ' Find the table's last row after resizing
    Dim newlastRow As Long
    newlastRow = targetTable.HeaderRowRange.Row + targetTable.Range.Rows.Count
    
    ' Clear range contents and formatting
    targetSheet.Range(targetSheet.Cells(newlastRow, targetTable.Range.Cells(1).Column).Address, targetSheet.Cells(previousLastRow, targetTable.Range.Cells(targetTable.Range.Columns.Count).Column).Address).Clear
    
    ' Delete all rows in range
    targetSheet.Range(targetSheet.Cells(newlastRow, targetTable.Range.Cells(1).Column).Address, targetSheet.Cells(previousLastRow, targetTable.Range.Cells(targetTable.Range.Columns.Count).Column).Address).EntireRow.Delete
    
    Dim tableCell As Range
    Dim rowWithFormulas As Long
    rowWithFormulas = 1
    For Each tableCell In targetTable.ListRows(rowWithFormulas).Range
    
        If tableCell.HasFormula Then
        
            tableCell.Copy targetTable.ListColumns(tableCell.Column).DataBodyRange
        
        End If
    
    Next tableCell
    
End Sub

Give it a try and let me know if it works.

Upvotes: 1

Related Questions