Event macro: insert row with formulae based on current row, clear selected contents

emsa · #1 04-16-2020, 12:02 PM

Good afternoon all,

I'm failing miserably to get the below macro to leave the data in the first two columns when a new row is inserted and the cell contents are cleared. Is there a line I can insert that basically says clear everything but leave the values that were in columns A and B.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Eliminate Edit status due to doubleclick
     Target.Offset(1).EntireRow.Insert
     Target.EntireRow.Copy Target.Offset(1).EntireRow
        On Error Resume Next
     Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
   On Error GoTo 0
End Sub

Can this line be modified somehow...

Code:

Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents

Any help would be greatly appreciated.

Regards,

Emsa

NoSparks · #2 04-16-2020, 01:36 PM

try

Code:

Intersect(Target.EntireRow.Offset(1), UsedRange).Offset(, 2).SpecialCells(xlConstants).ClearContents

emsa · #3 04-16-2020, 05:37 PM

Thank you NoSparks for the prompt reply.

I added the line to the macro and it adds the row but does not remove any values at all on the actual spreadsheet in question. I know your line of code is good because I tested it on another spreadsheet albeit with different formulas.

I've attached the spreadsheet Planning INSERT ROW BELOW TEST.xlsm if you wouldn't mind taking a look. Many thanks again.

Here's the macro...

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True   'Eliminate Edit status due to doubleclick
    Target.Offset(1).EntireRow.Insert
    Target.EntireRow.Copy Target.Offset(1).EntireRow
    On Error Resume Next
     Intersect(Target.EntireRow.Offset(1), UsedRange).Offset(, 2).SpecialCells(xlConstants).ClearContents
    'Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents
    On Error GoTo 0
End Sub

Regards,

emsa

NoSparks · #4 04-16-2020, 08:19 PM

seeing that your used range is all 16,384 columns
how about trying

Code:

Range(Cells(Target.Row+1, "C"), Cells(Target.Row+1, Columns.Count).End(xlToLeft)).SpecialCells(xlConstants).ClearContents

NoSparks · #5 04-17-2020, 03:51 AM

Formatting entire rows (that's 16,384 columns wide) or entire columns (that's 1,048,576 rows high) can make Excel think the UsedRange is greater than it really is.
I ran a little macro on your "Planning" sheet to reset the UsedRange. The originally suggested line of code then worked as offsetting of the UsedRange no longer tried to exceed Excel's last column.

Code:

Sub RemoveExcessiveUsedRange()
' reduce usedrange to what's actually used
    Dim Lastrow As Long, LastCol As Long

    Application.ScreenUpdating = False
    On Error Resume Next
    With Sheets("Planning") 'change sheet name as required
        Lastrow = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        LastCol = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlValues, _
                        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        .Range(.Cells(1, LastCol + 1), .Cells(Rows.Count, Columns.Count)).Delete
        .Range(.Cells(Lastrow + 1, 1), .Cells(Rows.Count, Columns.Count)).Delete
    End With
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

prior to running the macro:
?activesheet.usedrange.rows.count
683
?activesheet.usedrange.columns.count
16384
after running the macro:
?activesheet.usedrange.rows.count
41
?activesheet.usedrange.columns.count
18

Hope this helps.

emsa · #6 04-17-2020, 09:03 AM

Good afternoon NoSparks,

Your latest line of code works like a dream thank you so much. Now that there are two lines that will work which one do you recommend I should use in my macro?

Is the RemoveExcessiveUsedRange macro something I can run on occasion should I come across any problems?

Once again, thank you so much for your time.

Kind regards,

emsa

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro - Copying and Pasting selected slides (based on selected keywords/criteria) Hi	erickhawe	PowerPoint	0	08-16-2019 09:00 PM
Need macro for automatic point value insertion based on the number of answer choices selected	ganesang	Word VBA	29	08-12-2018 09:38 PM
Need macro for automatic point value insertion based on the number of answer choices selected	ganesang	Word	1	07-31-2018 06:07 AM
a macro that can copy data from copy.xls to our current excel macro.xls based on criteria:	udhaya	Excel Programming	1	11-12-2015 10:12 AM
Need macro to fill data from different sheets based on selected item from drop down	skorasika	Excel Programming	1	03-13-2015 11:25 AM