|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Event macro: insert row with formulae based on current row, clear selected contents
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 Code:
Target.Offset(1).EntireRow.SpecialCells(xlConstants).ClearContents Any help would be greatly appreciated. Regards, Emsa |
#2
|
|||
|
|||
try
Code:
Intersect(Target.EntireRow.Offset(1), UsedRange).Offset(, 2).SpecialCells(xlConstants).ClearContents |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
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 |
#5
|
|||
|
|||
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 ?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. |
#6
|
|||
|
|||
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 | 31 | 08-12-2018 10:19 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 |