Delete cells in column after last row in another

Question

I would like to clear content of cells (not delete rows) in a column after the last row of another column. The code would act as follows to work properly

Go to last cell in column BA,
move to the right to column BB
delete all rows in BB below that last rows

When I try recording the macro the code includes the range of that last cell as a fixed place. This is the code, I highlighted where I believe the issue is

    Sub CopyPaste2()
'
' CopyPaste2 Macro
'

'
    Columns("AS:AV").Select
    Selection.Copy
    Columns("AX:AX").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    **Range("BA7").Select
    Selection.End(xlDown).Select
    Range("BB47").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.ClearContents**
    Range("BB46").Select
    Selection.End(xlUp).Select
    Range("BB7").Select
    Selection.AutoFill Destination:=Range("BB7:BB46")
    Range("BB7:BB46").Select
    Range("BA6").Select
    ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort.SortFields.Add _
        Key:=Range("BA7:BA46"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level").Sort
        .SetRange Range("AX6:BB46")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Im pretty new to VBA so really appreciate your help

enter image description here

CLR · Answer 1 · 2022-08-04T07:56:50.200

Try this:

Add the following line near the top of your code - traditionally, we tend to declare our variables at the start of a procedure:

'declare 'lastrow' to store value of row number
Dim lastrow As Long

And then at the end of your code, after the sort etc., add this:

With ActiveWorkbook.Worksheets("KPI - Efficiency - Case Level")
    ' find last used row of column BA and add 1
    lastrow = .Range("BA" & .Rows.Count).End(xlUp).Row + 1
    ' clear from 'lastrow' to bottom of sheet in column BB
    .Range("BB" & lastrow & ":BB" & .Rows.Count).ClearContents
End With

I can see you've recorded this macro, so it's a little messy. If you're interested in learning how to craft better vba that is more portable and easier to read, you will want to read up on avoiding Select etc.:

How to avoid using Select in Excel VBA

This worked perfectly. Thank you so much. Thanks for also recommending how to improve my code. — noor akroush, Aug 04 '22 at 08:01
You're welcome. If you're happy with the answer, don't forget to mark it as answered when you can. — CLR, Aug 04 '22 at 09:00

score 0 · Answer 2 · answered Aug 04 '22 at 11:17

Clear the Cells Below a Range

If rg is a range object, to clear all cells below it, you can use the following line:

rg.Resize(rg.Worksheet.Rows.Count - rg.Row - rg.Rows.Count + 1).Offset(rg.Rows.Count).Clear

In the code, some parts of it are replaced with variables:

drg.Resize(ws.Rows.Count - FirstRow - rCount + 1).Offset(rCount).Clear

If rg has only one row, you can simplify with:

rg.Resize(rg.Worksheet.Rows.Count - rg.Row).Offset(1).Clear

Clear Below

Sub ClearBelow()
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)

    Dim lCell As Range

    ' ("Go to last cell in column BA")
    ' Reference the last non-empty cell in column 'BA' using 'End'
    ' (in the code the Find method is used instead of the End property).
    Set lCell = ws.Cells(ws.Rows.Count, "BA").End(xlUp)
    
    ' ("Move to the right to column BB")
    ' Reference the cell adjacent to the right using offset.
    Set lCell = lCell.Offset(, 1)
    ' Reference the cell in the same row but in column 'BB' using 'EntireRow'.
    ' (can be any column).
    'Set lCell = lCell.EntireRow.Columns("BB")
    
    ' ("Delete all rows in BB below that last rows")
    ' Clear all cells below the cell using 'Resize' and 'Offset'.
    lCell.Resize(ws.Rows.Count - lCell.Row).Offset(1).Clear

End Sub

The Code

Option Explicit

Sub CopyPaste2() ' be more creative e.g. 'CreateEfficiencyReport'!
    
    ' Define constants.
    Const wsName As String = "KPI - Efficiency - Case Level"
    Const sColumnsString As String = "AS:AV" ' Source Copy Columns
    Const dFirstColumnString As String = "AX" ' Destination First Copy Column
    Const FirstRow As Long = 7
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the worksheet ('ws').
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    ' To make sure that the worksheet is not filtered, when the remaining
    ' code would fail, you could use the following:
    'If ws.FilterMode Then ws.ShowAllData
    
    ' Reference the source columns range ('scrg') ('$AS$7:$AV$1048576').
    Dim scrg As Range: Set scrg = ws.Rows(FirstRow).Columns(sColumnsString) _
        .Resize(ws.Rows.Count - FirstRow + 1)
    'Debug.Print scrg.Address(0, 0)
    
    ' Attempt to reference the last cell ('lCell'), the bottom-most
    ' non-empty cell in the source columns range (for the bottom-most
    ' non-blank cell, use 'xlValues' instead of 'xlFormulas').
    Dim lCell As Range
    Set lCell = scrg.Find("*", , xlFormulas, , xlByRows, xlPrevious)
    If lCell Is Nothing Then Exit Sub ' no data
    'Debug.Print lCell.Address(0, 0)
    
    ' Reference the source range ('srg').
    Dim srg As Range: Set srg = scrg.Resize(lCell.Row - FirstRow + 1)
    'Debug.Print srg.Address(0, 0)
    
    ' Write the number of rows and columns of the source range
    ' to variables ('rCount', 'cCount').
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim dcrg As Range ' Destination Copy Range
    Dim dfcCell As Range ' Destination First Copy Cell
    
    ' Reference the destination first copy cell ('dfcCell').
    Set dfcCell = ws.Cells(FirstRow, dFirstColumnString)
    ' Reference the destination copy range ('dcrg').
    Set dcrg = dfcCell.Resize(rCount, cCount)
    'Debug.Print dcrg.Address(0, 0)
    
    ' Copy the values from the source range to the destination copy range.
    dcrg.Value = srg.Value
    
    Dim dfrg As Range ' Destination Formula Range
    Dim dffCell As Range ' Destination First Formula Cell
    
    ' Reference the destination first formula cell ('dffCell')
    ' in the column adjacent to the right of the copy range.
    Set dffCell = dfcCell.Offset(, cCount)
    ' Reference the destination formula range ('dfrg').
    Set dfrg = dffCell.Resize(rCount)
    'Debug.Print dfrg.Address(0, 0)
    
    Dim drg As Range ' (Whole) Destination Range
    
    If rCount > 1 Then
        
        ' Write the formula from the first formula cell to the remaining cells
        ' of the destination formula range.
        dfrg.Formula = dffCell.Formula
    '
        ' Reference the destination range ('drg').
        Set drg = dcrg.Resize(, cCount + 1) ' include the formula column
        'Debug.Print drg.Address(0, 0)
        
        ' Sort the destination range ('drg') by the last column
        ' of the copy range.
        drg.Sort drg.Columns(cCount), xlAscending, , , , , , xlNo
    
    'Else ' there is only one row of data; do nothing
    End If
    
    ' Clear the cells below the destination range.
    drg.Resize(ws.Rows.Count - FirstRow - rCount + 1).Offset(rCount).Clear

End Sub

Delete cells in column after last row in another

2 Answers2

Clear the Cells Below a Range