I try to write a macro that on double click of a cell, inserts a new row below that cell with some formulas. The important thing for me is that if I double click the cell again, then the formulas of the previously inserted line are updated with the right indexes.
For example, in the code below, double click A1 will insert the formula =B2+1 in line 2. Double clicking again should insert the same in line 2. But now line 2 shifter to line 3, so the formula in A3 should be =B3+1.
Here is the code I have so far:
Option Explicit
Const MYRANGE As String = "A:A"
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'If Sh.Name <> "Sheet1" Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Sh.Range(MYRANGE)) Is Nothing Then Exit Sub
Cancel = True
Target.Rows(2).Insert
Dim newRow开发者_如何学编程 As Range
Set newRow = Target.Rows(2)
Dim rowIndex As Long
rowIndex = newRow.row
newRow.Cells(1, 1).Formula = "=B" & rowIndex & "+1"
End Sub
UPDATE: Changing Target.Rows(2).Insert
to Target.Offset(1).EntireRow.Insert
solves the issue. Leaving the question open for explanations on what is Offset and how it differs from Rows (The property EntireRow does not exist for Rows(2))
You can reduce this code by four lines for the same outcome, pls see below
Note though that your code is updating cells in your target row and below, ie it won't be updating any cell formulae outside column A that reside above your target. Which is probably not an issue but worth mentioning. If you wanted a full update then you would always insert at row2 rather than at target
Option Explicit
Const MYRANGE As String = "A:A"
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Sh.Range(MYRANGE)) Is Nothing Then Exit Sub
Cancel = True
Target.Offset(1).EntireRow.Insert
Target.Offset(1).Formula = "=B" & Target.Row + 1 & "+1"
End Sub
精彩评论