Search code examples
excelvbacollections

Store the existing value and the new input value and calculate a result

The purpose is that the user types the new value into the cell during a counting task instead of recalculating again and again.

Dim OldValues As New Collection 'Variable to store OldValues

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Areas.Count > 1 Or Target.Count > 1 Or TypeName(Target) <> "Range" Then Exit Sub 'exclude buttons, shapes areas multiple selections
    Set OldValues = Nothing
    Dim CelL As Range
    For Each CelL In Target
        OldValues.Add CelL.Value, CelL.Address 'put value to collection
    Next CelL
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Areas.Count > 1 Or Target.Count > 1 Or TypeName(Target) <> "Range" Then Exit Sub 'same like above
On Local Error Resume Next
    Dim CelL As Range, ValInput As Long, ValOffsetLong As Long, ValOld As Long, ValNew As Long, ValOffsetString As String, r As Long, c As Long
    Dim keyCells As Range: Set keyCells = Range("C12:C19,C22:C29")
    On Error Resume Next
    Set keyCells = Application.Union(keyCells.Precedents, keyCells)
    Application.EnableEvents = False
    If Not Application.Intersect(Target, keyCells) Is Nothing Then
        r = Target.Row ' using this to find the target address
        c = Target.Column ' using this to find the target address
        ValInput = Target.Value ' store the input
        ValOffsetLong = Target.Offset(163, 11) ' find the offset value
        ValOffsetString = Target.Offset(163, 11).Address(0, 0) ' find the offset address
        ValOld = OldValues(CelL.Adress) ' taking the value from SelectionChange
        ValNew = ValInput + ValOld - ValOffsetLong ' calculate
        For Each CelL In Target
            Debug.Print "/SelctedCell(Target): " & CelL.Address & " /Input(CelL.Value): " & CelL.Value & " /ValInput: " & Target.Value _
              & " /ValOld: " & OldValues(CelL.Address) & " /ValOffsetLong: " & ValOffsetLong & " /ValNew " & ValNew & " /ValOffsetString: " & ValOffsetString
            Cells(r, c).Formula = "=" & ValNew & "+" & ValOffsetString 'write the needed formula again in cell
        Next CelL
    End If
    Set OldValues = Nothing
    For Each CelL In Target
        OldValues.Add CelL.Value, CelL.Address
    Next CelL
    Application.EnableEvents = True
End Sub

The script should

  • save the cell value of the selected cell when changing or activating the cell
  • save the new input value when changing the cell (new value)
  • store a third value resulting from other calculations in a variable (offset)
  • put the whole thing into a result variable and write a formula into the active cell with this new value.

With Debug.Print I can see all variables are correct. Nevertheless always a wrong result comes out.
The calculation of the variable "ValNew" doesn't seem to work.
It seems the old Value (from the collection "OldValues") is empty when I press Enter.

Before (empty cell or cell with a number or cell with formula)
Cell Range C22:C29

Then enter a number which is added to the current cell value but without the value of cell N190 (enter 10) the script should store the cell value in collection OldValues store the input ValInput = Target.Value then take the input value, add the old value subtract the offset value and write a formula with this result (+ offset adress) ValNew = ValInput + ValOld - ValOffsetLong but:
result

It seems that only the Input Value will be processed since the old value was 1 the new is 10 +N190 = 12 but the result shows 9 +N190 means to me ValNew = ValInput - ValOffsetLong had been processed and ValNew = ValInput + ValOld - ValOffsetLong not. ValOld is not empty but ignored.
print of variables

Solution

  • It still is very challenging to understand your requirement (not your issues regarding your own code ...)

    Try this code - it has to go into the sheets module:

    Option Explicit

Private m_colOldValues As Collection

Private Property Get rgKeyCells() As Range
    Set rgKeyCells = Me.Range("B5:B11") '---> adjust this to your needs 
    Me.Range("C12:C19,C22:C29")
End Property

Private Property Get rgOffset(c As Range) As Range
    Set rgOffset = c.Offset(, 2) '---> adjust this to your needs: c.Offset(163, 11)
End Property

Private Sub readOldValues()
    Dim c As Range
    Set m_colOldValues = New Collection
    For Each c In rgKeyCells.Cells
        m_colOldValues.Add c.Value - rgOffset(c).Value, c.Address
    Next
End Sub

Private Sub updateCell(c As Range)
    c.Value = "=" & c.Value & " + " & m_colOldValues(c.Address) & " + " & rgOffset(c).Address
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Application.EnableEvents = False
    For Each c In Target.Cells
        If Not Intersect(c, rgKeyCells) Is Nothing Then
            updateCell c
        End If
    Next
    Application.EnableEvents = True

    readOldValues
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If m_colOldValues Is Nothing Then
        readOldValues
    End If
End Sub

    I used the following setup: enter image description here