View Single Post
  #9   Report Post  
Posted to microsoft.public.excel.programming
Dave[_85_] Dave[_85_] is offline
external usenet poster
 
Posts: 5
Default Worksheet_BeforeDoubleClick subtract sum of cells below top cell

On Monday, January 4, 2021 at 9:23:25 PM UTC+10:30, Peter T wrote:
Hello Peter,

I really appreciate your reply and yes I was being a bit vague and just
realised I stuffed up with my end result calculation (sorry for any
confusion).
If you do a web search on 'First' cell or 'Top' cell there are many, many
results without being specific to what I was asking and the terms seemed to
generate quite a bit of confusion.
I was deliberately trying to avoid using cell references as I have noted on
various other forums that even though someone asks for a dynamic or non
specific range, as soon as they quote cell references the answers come back
with specific column and row references.
So here is my question in term of cell references:
D3 = 5,180
D4 = 1,220
D5 = (1,380 / 2)
D6 = (500 + 500)
D7 = 2,270

So if you double click in cell D7 (blank cell) the macro would insert a
formula i.e. D3 - D4 - D5 - D6 OR D3 - SUM(D4:D6)
I was hoping the result would be a formula and not a value, so I can select
it in the formula bar and check or manually edit which cells were used in
the formula calculations.

Thank you for your help.
Regards, David
=============================
Hi David,

I take it you didn't see the example I posted yesterday...?

From your detail above I see I misunderstood what defines the 'top cell' and
in turn the sum range, so try this instead -
' 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 the formula cell (or at least 3?)
ElseIf IsEmpty(Target) Or Target.HasFormula Then
' the cell is empty or has a formula (to be amended)
Cancel = True
AddFormula Target
End If

End Sub
Sub AddFormula(rFormulaCell As Range)
Dim lSumRows As Long, lTopCellRow As Long
Dim sSumAddr As String, sTopCellAddr As String
Dim sFml As String
With rFormulaCell
' first row of the contiguous cells above
lTopCellRow = .Cells(0, 1).End(xlUp).Row

' top cell address
sTopCellAddr = .Offset(lTopCellRow - .Row, 0).Address(False, False)

' count rows to sum = formulaCellRow - topCellRow - 1 (exclude the
top cell)
lSumRows = .Row - lTopCellRow - 1
' the sum address
sSumAddr = .Offset(-lSumRows).Resize(lSumRows).Address(False, False)
' create the formula
sFml = "=" & sTopCellAddr & " - Sum(" & sSumAddr & ")"

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

End Sub


Peter T

Hello Peter,

Firstly.... wow... I cannot thank you enough for persisting with me.
Your solution is fantastic and the optional font colour was a nice touch.

Yes I did see your previous code and for some reason I could not get it to work.
I created several contiguous ranges in several columns and right clicked above, below and to the left and right and nothing happened.
It was only when I right clicked in row 1 that something happened and that was a 'Run-time error '1004:''

I really appreciate all your help and if there is an option, I would mark this as solved.

Regards, David