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
CodePudding user response:
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
CodePudding user response:
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