Sudoku-lite challenge

Question

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

Sheet 1:

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

Module Main:

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

        Application.EnableEvents = False
        Set masterRange = Range("B1:E5")
        Set valuesToFillRange = New CollectionOfGeneratedValues
        If Not Intersect(masterRange, target) Is Nothing Then
            If checkUserInputValid(target) Then Exit Sub
            valuesToFillRange.generateValues target
            valuesToFillRange.shuffleCollection
            Call printValues(valuesToFillRange, target)
        End If
        Application.EnableEvents = True
End Sub

Function checkUserInputValid(ByRef userInput As Range) As Boolean
    checkUserInputValid = False
    If userInput.value > getSumTarget(userInput) Then
        MsgBox ("WILL NOT CALCULATE FOR ROW " & userInput.Row & ", USER INPUT GREATER THEN SUMTARGET")
        checkUserInputValid = True
        Application.EnableEvents = True
    End If
End Function

Function getSumTarget(ByRef userInput As Range) As Long
    getSumTarget = Range("F" & userInput.Row)
End Function

Function printValues(ByRef valuesToFillRange As CollectionOfGeneratedValues, ByRef userInput As Range)
Dim rangeToFill                     As Range
Dim collectionCounter               As Long
Dim cellInRangeToFill               As Range

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

Class named CollectionOfGeneratedValues:

Option Explicit
Private CollectionOfGeneratedValues As Collection

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

Private Sub Class_Terminate()
    Set CollectionOfGeneratedValues = Nothing
End Sub

Private Property Get NewEnum() As IUnknown
    Set NewEnum = CollectionOfGeneratedValues.[_NewEnum]
End Property

Friend Property Get Count() As Long
    Count = CollectionOfGeneratedValues.Count
End Property

Friend Sub Add(num As Long)
    CollectionOfGeneratedValues.Add num
End Sub

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

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

Public Sub shuffleCollection()
Dim holdValuesArray                As Collection

    Set holdValuesArray = generateColOfValues()
    Call swap(holdValuesArray)
End Sub

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

    Set generateColOfValues = New Collection
    maxNum = Me.Count
    For counter = 1 To maxNum
        generateColOfValues.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

Public Sub generateValues(ByRef userInput As Range)
Dim userSetValue                    As Long
Dim sumTarget                       As Long
Dim sumLeft                         As Long
Dim numbersToGenerate               As Long

    userSetValue = userInput.value
    sumTarget = getSumTarget(userInput)
    sumLeft = setInitialSumLeft(sumTarget, userSetValue)
    numbersToGenerate = getNumbersToGenerate(userInput)
    Call getValues(numbersToGenerate, sumLeft)
End Sub

Private Function getSumTarget(ByRef userInput As Range) As Long
    getSumTarget = Range("F" & userInput.Row)
End Function

Private Function setInitialSumLeft(ByVal sumTarget As Long, ByVal userSetValue As Long) As Long
    setInitialSumLeft = sumTarget - userSetValue
End Function

Private Function getNumbersToGenerate(ByRef userInput As Range) As Long
Dim rangeToFill                     As Range

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

Private Sub getValues(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

Answer 1

The usage of Worksheet_Change event should really have a check built into it e.g.

Private Sub Worksheet_Change(ByVal target As Range)
    Dim workingRange As Range
    Set workingRange = Sheet1.Range("A2:E5")
    If Not Intersect(target, workingRange) Is Nothing Then Main.Main target
End Sub

This way you won't need to pass target unnecessarily, or check for errors after passing it. I think it's sort of un-intuitive to pass a possible error to Main to check when you could just avoid executing it entirely.

But, I'm just going to ignore that event, it's difficult to troubleshoot, so I'm just going to call Main manually.

---

Call printValues(valuesToFillRange, target)

You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument

You also have some Friends in your Class, there's no reason for that. In general those would be Public as Friend isn't really used in VBA. Because VBA is old school, but not too old school. Just the right amount of confusion.

---

Naming

First - you've done a good job naming everything, declaring everything and properly typing most things. So these are just some improvements I see.

You're using UserInput a few times, but you aren't actually asking for input from a user - that's a bit confusing. Instead it might be the targetRow or something like that, because once you get the target, the user is no longer involved.

 Function checkUserInputValid(ByRef userInput As Range) As Boolean

This is a boolean function, which normally is named as such e.g. IsValidInput

So now your check would read

 If IsValidInput(target) Then Exit Sub

But really here you're testing for something to be negative, which isn't intuitive. Switch that up so IsValidInput returns True for good input and False for bad input. And then If IsValidInput Then ... Else Exit Sub

Also, booleans are initialized as false, so you don't need to set it to false.

Also, with your functions and subs you're using camelCase naming - you should use ProperCase for these. You use camelCase for local variables and then UPPER_SNAKE for constants.

Sub Main isn't telling me anything - normally it's a given that there's a Main, but why not just give it an indication like BeginSudokuSolve?

Also I think getSumTarget would be GetTargetSum - but that's not a big deal. Your functions are telling me what they do, so they have generally good names, even if they might be able to be more concise.

---

ByRef

You're also passing your argument ByRef which isn't needed - once you have target you can just pass the range ByVal - which isn't to say you only pass the value of the range, but you only pass the identity of the range, instead of the actual range - trust me it's faster.

Same for

Sub Main(ByRef target As Range)
Function getSumTarget(ByRef userInput As Range) As Long
Function printValues(ByRef valuesToFillRange As CollectionOfGeneratedValues, ByRef userInput As Range)
Private Sub swap(ByRef holdValuesArray As Collection)
Public Sub generateValues(ByRef userInput As Range)
Private Function getSumTarget(ByRef userInput As Range) As Long
Private Function getNumbersToGenerate(ByRef userInput As Range) As Long

---

Functions

You have a Function printValues that isn't given a type. This means it's not returning anything (as a function does) and would instead be a Sub.

You also have Main.getSumTarget and CollectionOfGeneratedValues.getSumTarget that do the same thing. If you only need this value once (which is true, even if you use it more than once), just get it, store it and pass it. Or assign it to a Class property from Main.

---

Private Function getNumbersToGenerate(ByRef userInput As Range) As Long
Dim rangeToFill                     As Range

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

This is a bit weird. It could just be a constant of 4 right? A to E minus 1. If this exists for extending the ability of the application, then A and E should not be hard-coded, but instead read based on the target.

It's also not getting the numbers, it's getting the amount of numbers to generate. But you have a Get Count property, so it's probably not needed at all, is it?

---

I don't know if I broke it, but printing like this

cellInRangeToFill.value = valuesToFillRange(collectionCounter)

Doesn't work. I'd need valuesToFillRange.Item(collectionCounter) for it to be valid.

---

Method

So the problem statement doesn't seem like it's outlined how to refill the values. I think that's what you're doing with shuffle and swap?

So if the method should keep as many numbers the same as before, that would be straight-forward. If the method calls to get all the numbers as close to one another as possible, that would be another problem. If everything doesn't need to be integers, we have an entirely new approach. Essentially the method that you're using is arbitrary and shouldn't be evaluated.

One thing, though, I think is that you should check if the target row already adds up to the target sum, before even going forward.

Private Sub Worksheet_Change(ByVal target As Range)
        Dim workingRange As Range
        Set workingRange = Sheet1.Range("A2:E5")
        If Not Intersect(target, workingRange) Is Nothing Then
            If NotAlreadyEqual(target) Then Main.Main target
        End If
End Sub

---

Class

I don't see Private Property Get NewEnum() As IUnknown ever used. I'm not sure VBA even knows what to do with it.

It looks like your class is a collection. And that collection has properties, as does your class. You sort of have a level of abstraction here (which is why I needed to specify .Item earlier). Let's take a look at exactly what your class does -

1. Create Collection
2. Get target's value
3. Get target sum
4. Subtract new value from target sum
5. Get new values (in several steps)

That could be simpler - for instance this class RowValues

Option Explicit
    Const NUMBER_OF_ELEMENTS As Long = 5
    Private valueArray() As Long
    Private pTargetSum As Long

    Public Property Let ArrayOfValues(value As Variant)
        ReDim valueArray(1 To NUMBER_OF_ELEMENTS)
        valueArray(value.Column) = value.value
    End Property

    Public Property Get ArrayOfValues() As Variant
        ArrayOfValues = valueArray
    End Property

    Public Property Let TargetSum(value As Long)
        pTargetSum = value
    End Property

    Public Sub GenerateValues()
        'figure out current sum
        'generate values for elements not 0
        'fill up array however you want
    End Sub

If it's always A to E, then it's easy to base everything on the initial target from worksheet_change and use your algorithm, or any other, to fill in new elements and spit them back out.

---

So disregarding the class, you'd end up with something like

Sheet1

Option Explicit
Private Sub Worksheet_Change(ByVal target As Range)
    Dim workingRange As Range
    Set workingRange = Sheet1.Range("A2:E5")

    If Not Intersect(target, workingRange) Is Nothing Then
        If Main.NotAlreadyEqual(target) Then Main.GenerateValues target
    End If
End Sub

Main

Option Explicit

Sub GenerateValues(ByVal target As Range)
Dim valuesToFillRange As RowValues
Set valuesToFillRange = New RowValues
valuesToFillRange.ArrayOfValues = target
valuesToFillRange.TargetSum = Sheet1.Cells(target.Row, 6).value
valuesToFillRange.GenerateValues
'print


End Sub

Public Function NotAlreadyEqual(ByVal target As Range) As Boolean
    Dim targetRow As Long
    Dim currentSum As Long
    Dim element As Long
    targetRow = target.Row
    For element = 1 To 5
        currentSum = currentSum + Sheet1.Cells(targetRow, element)
    Next
    If currentSum < Sheet1.Cells(targetRow, 5) Then NotAlreadyEqual = True
End Function

Class

Option Explicit
    Const NUMBER_OF_ELEMENTS As Long = 5
    Private valueArray() As Long
    Private pTargetSum As Long
    Private pTargetRow
    Private newElement As Long

    Public Property Let ArrayOfValues(value As Variant)
        ReDim valueArray(1 To NUMBER_OF_ELEMENTS)
        valueArray(value.Column) = value.value
        pTargetRow = value.Row
        newElement = value.Column
    End Property

    Public Property Get ArrayOfValues() As Variant
        ArrayOfValues = valueArray
    End Property

    Public Property Let TargetSum(value As Long)
        pTargetSum = value
    End Property


    Public Sub GenerateValues()
        Dim currentSum As Long
        currentSum = Application.WorksheetFunction.Sum(valueArray)
        Dim delta As Long
        delta = pTargetSum - currentSum
        Dim index As Long
        For index = LBound(valueArray) To UBound(valueArray)
            If valueArray(index) = 0 Then valueArray(index) = Int(delta / 4)
        Next
        currentSum = Application.WorksheetFunction.Sum(valueArray)
        delta = pTargetSum - currentSum
        If delta <> 0 Then
            index = Int((5 * Rnd) + 1)
            If index <> newElement Then valueArray(index) = valueArray(index) + delta
                If index = newElement Then
                    Select Case newElement
                        Case 5
                            valueArray(index - 1) = valueArray(index - 1) + delta
                        Case Else
                            valueArray(index + 1) = valueArray(index + 1) + delta
                    End Select
                End If
        End If
    End Sub