开发者

excel: insert row updating formulas

开发者 https://www.devze.com 2023-04-05 12:40 出处:网络
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 t

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
0

精彩评论

暂无评论...
验证码 换一张
取 消