User Inputs Value Into A Range - Rest Of Cells In

Question

I'm trying to have a formula somewhat like a sum function. The only difference is that once it sums up the amounts of 3 cells (or more) it will edit a certain cell to maintain that total value if another cell is edited.

For example:

Column A, B, and C are each 3 and together equal 9:

| A  |  B  |  C |...| Total |
+----+-----+----+...+-------+
| 3  |  3  |  3 |...|   9   |

Columns A and B are edited to equal 2 each, but I still want to maintain the total of 9, so I want column C to automatically change to 5.

this:

| A  |  B  |  C |...| Total |
+----+-----+----+...+-------+
| 2  |  2  |  3 |...|   7   |

should update to:

| A  |  B  |  C |...| Total |
+----+-----+----+...+-------+
| 2  |  2  |  5 |...|   9   |

The reasoning behind this is because it is being sent to multiple parts of the country where only 2 cells will be edited, but I want to maintain a total without having to edit 2k+ rows of data inputs.

I'm open to a VBA option as well. Anyone have any ideas?

Answer 1

You can find the problem here.

The example:

Column A, B, and C are each 3 and together equal 9:

| A  |  B  |  C |...| Total |
+----+-----+----+...+-------+
| 3  |  3  |  3 |...|   9   |

Columns A and B are edited to equal 2 each, but I still want to maintain the total of 9, so I want column C to automatically change to 5:

| A  |  B  |  C |...| Total |
+----+-----+----+...+-------+
| 2  |  2  |  3 |...|   7   |

I realized that my code was a bit of a mess, so I broke it into sheet1, module main and a class named CollectionOfGeneratedValues.

The only variables you have to adjust in your code are the masterRange, Columns in rangeToFill and a column in sumTarget to suit your data input.

Quick runthrough:

• You have to set the masterRange, or the range that you are working with, inside VBA. Inside the spreadsheet you must set the sumtarget for each row of the masterRange.

• When a value is entered into a cell inside of your masterRange, we find out what row this is and generate a separate range that is just that row.

• If the input amount is greater than the sumTarget we Exit Sub and scold user.

• We generate an array of values whose sum, along with user input will be the sumtarget. We then take the sum target and subtract the user input.

  • Afterwards generate a random number between 0 and the new sumtarget.value
  • We then store that rand number and subtract its value from sumtarget.
  • We do this columnsInRange - 1 times.
  • When we step out of the for loop for the last value we set the value to whatever is leftover of sumtarget.
  • With the collection that was created by the steps above we perform a Fisher-Yates Shuffle, so that we don't always the values of collection / our spreadsheet come in a descending order

UPDATE: Thank you for your comments, advice and help. I should have given more thought what form looks like. I have been left with some sort of weird dynamic / static hybrid. A custom UserForm that generates sets of these and then can print into a worksheet would have been cool. Regardless, I took most of Raystafarian's advice. Some of it, like where to store input checking logic, I prefer my way. But generally his advice is spot on. Thank you again.

Sheet 1:

Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
    SolveSudokuLite.Main target
End Sub

Module SolveSudokuLite:

Option Explicit Sub Main(ByRef target As Range) Dim masterRange As Range Dim rangeToFill As Range Dim valuesToFillRange As GeneratedValuesCollection

        Application.EnableEvents = False
        Set masterRange = Range("B1:E5")
        Set valuesToFillRange = New GeneratedValuesCollection
        If Not Intersect(masterRange, target) Is Nothing Then
            TargetSum.setTargetSum target
            If Not IsValidInput(target) Then Exit Sub
            valuesToFillRange.GenerateValues target
            PrintValues valuesToFillRange, target
        End If
        Application.EnableEvents = True
End Sub

Function IsValidInput(ByVal target As Range) As Boolean
    IsValidInput = True
    If (target.value >= TargetSum.sum) Or Not IsNumeric(target.value) Then
        MsgBox ("WILL NOT CALCULATE FOR ROW " & target.Row & ", USER INPUT INVALID")
        IsValidInput = False
        Application.EnableEvents = True
    End If
End Function

Function PrintValues(ByRef valuesToFillRange As GeneratedValuesCollection, ByVal target As Range)
Dim rangeToFill                     As Range
Dim collectionCounter               As Long
Dim cellInRangeToFill               As Range

    Set rangeToFill = Range("A" & target.Row & ":E" & target.Row)
    collectionCounter = 1
    For Each cellInRangeToFill In rangeToFill
        If cellInRangeToFill.Address = target.Address Then
            cellInRangeToFill.value = target.value
        Else
            cellInRangeToFill.value = valuesToFillRange.Item(collectionCounter)
            collectionCounter = collectionCounter + 1
        End If
    Next cellInRangeToFill
End Function

Class named GeneratedValuesCollection:

Option Explicit
Private GeneratedValuesCollection As Collection

Private Sub Class_Initialize()
    Set GeneratedValuesCollection = New Collection
End Sub

Private Sub Class_Terminate()
    Set GeneratedValuesCollection = Nothing
End Sub

Public Property Get Count() As Long
    Count = GeneratedValuesCollection.Count
End Property

Public Sub Add(num As Long)
    GeneratedValuesCollection.Add num
End Sub

Public Property Get Item(Index As Variant) As Long
     Item = GeneratedValuesCollection.Item(Index)
End Property

Public Sub Clear()
    Set GeneratedValuesCollection = New Collection
End Sub

Public Sub GenerateValues(ByVal target As Range)
Dim userSetValue                    As Long
Dim sumLeft                         As Long
Dim numbersToGenerate               As Long

    userSetValue = target.value
    sumLeft = SetInitialSumLeft(userSetValue)
    numbersToGenerate = NumberValuesToGenerate(target)
    SetValues numbersToGenerate, sumLeft
End Sub

Private Function SetInitialSumLeft(ByVal userSetValue As Long) As Long
    SetInitialSumLeft = TargetSum.sum - userSetValue
End Function

Private Function NumberValuesToGenerate(ByVal target As Range) As Long
Dim rangeToFill                     As Range

    Set rangeToFill = Range("A" & target.Row & ":E" & target.Row)
    NumberValuesToGenerate = rangeToFill.Columns.Count - 1
End Function

Private Sub SetValues(ByVal numbersToGenerate As Long, ByVal sumLeft As Long)
Dim counter                         As Long
Dim value                           As Long

    For counter = 1 To numbersToGenerate - 1
        value = Application.WorksheetFunction.RandBetween(0, sumLeft / 1.25)
        Me.Add value
        sumLeft = sumLeft - value
    Next counter
    Me.Add sumLeft
End Sub

Public Sub ShuffleCollection()
Dim holdValuesArray                As Collection

    Set holdValuesArray = DuplicateCollection()
    Swap holdValuesArray
End Sub

Private Function DuplicateCollection() As Collection
Dim counter                         As Long
Dim maxNum                          As Long

    Set DuplicateCollection = New Collection
    maxNum = Me.Count
    For counter = 1 To maxNum
        DuplicateCollection.Add Me.Item(counter)
    Next counter
End Function

Private Sub Swap(ByRef holdValuesArray As Collection)
Dim randomNum                       As Long
Dim maxNum                          As Long
Dim counter                         As Long

    Me.Clear
    maxNum = holdValuesArray.Count
    For counter = 1 To maxNum
        randomNum = Application.WorksheetFunction.RandBetween(1, holdValuesArray.Count)
        Me.Add (holdValuesArray(randomNum))
        holdValuesArray.Remove (randomNum)
    Next counter
End Sub

Class named TargetSum:

Option Explicit
Private CollectionOfGeneratedValues As Collection

Private Type TTargetSum
        sum As Long
End Type

Private this As TTargetSum

Public Property Get sum() As Long
    sum = this.sum
End Property

Public Sub setTargetSum(ByVal value As Range)
    this.sum = Range("F" & value.Row)
End Sub