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 |

enter image description here

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

• Donald.McLean: Please do not revise the code. If you do that, you will invalidate the answers given. If you want a review of the new revised code, you can post a new question
• Malachi: Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers .

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

• learnAsWeGo: am going through this, this weekend will respond. thank you very much for your time and effort. +1+1+1
• Raystafarian: There are also a few things I did that could be improved, such as using a constant for the target sum column or using an enum for the elements. My class method for generating numbers is pretty clunky, actually very clunky.