Faster clearing contents

[MSchädler]

I have the following question with this working VBA code and would appreciate some help (if at all possible) to make the code faster. Especially when clearing up to 50 cells.
The shown VBA code is copying the last row of a table and inserts it below.
Some cells are cleared from its contents. The code does it one by one.
I'm sure there must be a faster way to "ClearContents" the cell by cell.
Can somebody help me?

VBA code:

Private Sub Add_Click()
 Sheets("Overview").Unprotect Password:="XXX"
    myCheck = MsgBox("new project?", vbYesNo)
    If myCheck = vbNo Then Exit Sub

  ActiveSheet.Range("i65536").End(xlUp).EntireRow.Select 
Selection.Copy
     ActiveSheet.Range("i65536").End(xlUp).Offset(1, 0).EntireRow.Select      
     Selection.Insert

Range("J" & (ActiveCell.Row)).Value = Date

Range("K" & (ActiveCell.Row)).ClearContents
Range("L" & (ActiveCell.Row)).ClearContents
Range("N" & (ActiveCell.Row)).ClearContents
                   'and so on!
End Sub

 

[Trebor76]

Hi MSchädler,

Does this help:

Range("K" & ActiveCell.Row & ":L" & ActiveCell.Row & ",N" & ActiveCell.Row).ClearContents

Regards,

Robert

 

[MSchädler]

Hello Robert
Many thanks for your help. Your idea works in my sheet if I list every row that needs to be cleaned.
I'm looking for a way to say from "row K to row L" and from "row AB to BA" clear all contents?
Thanks for your reply?
Marc

 

[wideboydixon]

Like this?

Private Sub Add_Click()

Dim lastRow As Long
Const COLUMNS_TO_CLEAR = "J#,K#,L#,N#" ' comma separated list of columns to clear - # will be replaced by the row number

Sheets("Overview").Unprotect Password:="XXX"
If MsgBox("new project?", vbYesNo) = vbNo Then Exit Sub

lastRow = ActiveSheet.Range("I65536").End(xlUp).Row
ActiveSheet.Range(lastRow, "I").EntireRow.Copy Destination:=ActiveSheet.Range(lastRow + 1, 1)

ActiveSheet.Range(Replace(COLUMNS_TO_CLEAR, "#", CStr(lastRow + 1))).ClearContents

End Sub

WBD

 

[Rick Rothstein]

I'm looking for a way to say from "row K to row L" and from "row AB to BA" clear all contents?

Those are columns, not rows. Are you looking to clear those entire columns? If so...

Range("K:L,AB:BA").ClearContents

But if you actually wanted to clear the active cell's row only...

Intersect(Range("K:L,AB:BA"), ActiveCell.EntireRow).ClearContents

On the other hand, if you wanted something else, you will have to wait until I get up... going to sleep now.

 

[Rick Rothstein]

Those are columns, not rows. Are you looking to clear those entire columns? If so...

Range("K:L,AB:BA").ClearContents

But if you actually wanted to clear the active cell's row only...

Intersect(Range("K:L,AB:BA"), ActiveCell.EntireRow).ClearContents

On the other hand, if you wanted something else, you will have to wait until I get up... going to sleep now.

One more thing for the above. If you had certain ranges of rows that you wanted to clear for those columns (say Rows 3:5 and Rows 12:18)...

Intersect(Range("K:L,AB:BA"), Range("3:5,12:18")).ClearContents

And, of course, you can expanded the ranges to include more columns or rows as needed.

 

[wideboydixon]

That's good point. It might be easier to do this:

Private Sub Add_Click()

Dim lastRow As Long
Const COLUMNS_TO_CLEAR = "J:L,N:P,AB:BA" ' Columns to clear

Sheets("Overview").Unprotect Password:="XXX"
If MsgBox("new project?", vbYesNo) = vbNo Then Exit Sub

lastRow = ActiveSheet.Range("I65536").End(xlUp).Row
ActiveSheet.Range(lastRow, "I").EntireRow.Copy Destination:=ActiveSheet.Range(lastRow + 1, 1)
Application.Intersect(ActiveSheet.Range(lastRow, "A").EntireRow, ActiveSheet.Range(COLUMNS_TO_CLEAR)).ClearContents

End Sub

WBD

 

[MSchädler]

Hello Rick
Many thanks for this input which works in my sheet. The adapted vba code is now:

Private Sub CommandButton3_Click()
Sheets("Uebersicht").Unprotect Password:="XXX"
myCheck = MsgBox("new project?", vbYesNo)
If myCheck = vbNo Then Exit Sub
Application.ScreenUpdating = False
ActiveSheet.Range("R65536").End(xlUp).EntireRow.Select
Selection.Copy
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Selection.Insert
Range("P" & (ActiveCell.Row)).Value = Date
Intersect(Range("L:M,R:R,T:U,AB:BB"), ActiveCell.EntireRow).ClearContents
ActiveSheet.Range("R65536").End(xlUp).Offset(1, 0).EntireRow.Select
Range("L" & (ActiveCell.Row)).Select

Application.ScreenUpdating = True
End Sub

Thanks again!!!
Marc