"Dave" wrote in message
...
On Friday, January 1, 2021 at 1:29:22 AM UTC+10:30, Peter T wrote:
Dave,

I think you will need to explain much more clearly what you want to do. I
sort of got the gist but not enough to even think making a suggestion.

Peter T

Hello Peter,

I realised this probably did not make sense so I thought I had deleted the
post, so I was surprised to get a reply.

What I had been trying to achieve was a Worksheet_BeforeDoubleClick macro
where you could double click in a blank below a range of contiguous values
and it would insert a formula that would take the range of cells above the
active cell formula and below the top value (below a blank cell) and
subtract them from the top value, something like:
(top cell) 5,810 minus (next cell down) 1,220 minus (next cell down) 690
minus (next cell down) 1,000 = 2,900
= 5,180 - 1,220 - (1,380 / 2) - (500 + 500) = 2,900
Which is effectively subtracting every value from the first/top value, but
these contiguous cells/rows vary in size.
The other way of looking at it is effectively subtracting the SUM of all the
values below the first/top cell from the first/top cell, but not using
specific cell references written into the macro.

As the column may contain multiple contiguous groups I wanted to restrict
the Worksheet_BeforeDoubleclick macro to individual contiguous groups and
not the whole column.
I am hoping the macro will not be column or row specific, but be able to be
used anywhere on the worksheet and not affected by any other contiguous
groups in a column.

I hope this explanation make more sense ?

Regards, Dave


================================================== ========

I'm still not quite sure if I follow, particularly what defines the top cell
in all scenarios, but try this

' in the Worksheet module
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, _
Cancel As Boolean)

If Target.Count 1 Then
' multiple cells selected
ElseIf IsEmpty(Target(0, 1)) Then
' the cell above is empty
ElseIf IsEmpty(Target(-1, 1)) Then
' need at least two cells above to sum ???
ElseIf IsEmpty(Target) Or Target.HasFormula Then
' the cell is empty or has a formula (to be amended)
Cancel = True ' cancel the context menu
AddFormula Target
End If

End Sub

Sub AddFormula(rCell As Range)
Dim lFirstSumRow, lSumRows As Long, lTopCellRow As Long
Dim sSumAddr As String, sTopCellAddr As String
Dim sFml As String
Dim rCellTmp As Range

With rCell
' first row of the contiguous cells above
lFirstSumRow = .Cells(0, 1).End(xlUp).Row

' count rows to sum = row of formula row - first row in sum range
lSumRows = .Row - lFirstSumRow

' the sum address
sSumAddr = .Offset(-lSumRows).Resize(lSumRows).Address(False, False)

' sum formula
sFml = "Sum(" & sSumAddr & ")"

' define the top sum-range cell
Set rCellTmp = Cells(lFirstSumRow, .Column)
lTopCellRow = rCellTmp.End(xlUp).Row

If lTopCellRow 1 Then ' assume the topcell must be below row-1
?
sTopCellAddr = Cells(lTopCellRow, .Column).Address(False, False)
sFml = sTopCellAddr & " - " & sFml

.Formula = "=" & sFml ' apply the formula
.Font.Color = vbBlue ' optional font colour
End If
End With

End Sub
'''''''''''''''''''''''''''

Several ways of doing this but tried to make it easy to follow, adapt if/as
required.

Address(False,False) returns the Relative address, adapt to return Absolute

Peter T