Reputation: 49
before i begin i am very new to programming and excel vba so please be nice. i am attempting to make a program to automatically create balanced teams for friendly games of starcraft 2 based on an ongoing spreadsheet of our win loss ratios.
Here is a simplified version of that spreadsheet
I am then trying to use vba code to run through every possible team configuration and find two teams where the difference between the sum of the win/loss ratios are the smallest.
here is my code i hope u can understand all the variable names
Public Sub Main()
Dim TotalScore As Integer
TotalScore = 0
Dim TargetScore As Integer
TargetScore = 0
Dim CurrentScore As Integer
CurrentScore = 0
Dim InitialScoreDifference As Integer
InitialScoreDifference = 0
Dim ScoreDifference As Integer
ScoreDifference = 0
Dim Scores(0 To 7) As Long
Scores(0) = Worksheets("Sheet1").Cells(2, "D").Value
Scores(1) = Worksheets("Sheet1").Cells(3, "D").Value
Scores(2) = Worksheets("Sheet1").Cells(4, "D").Value
Scores(3) = Worksheets("Sheet1").Cells(5, "D").Value
Scores(4) = Worksheets("Sheet1").Cells(6, "D").Value
Scores(5) = Worksheets("Sheet1").Cells(7, "D").Value
Scores(6) = Worksheets("Sheet1").Cells(8, "D").Value
Scores(7) = Worksheets("Sheet1").Cells(9, "D").Value
For x = 0 To Scores(7)
TotalScore = TotalScore + Scores(x)
Next x
TargetScore = Int(TotalScore / 2)
InitialScoreDifference = (TotalScore)
Console.WriteLine (TotalScore)
Console.WriteLine (TargetScore)
Console.WriteLine (InitialScoreDifference)
For a = 0 To Scores(7)
For b = 0 To Scores(7)
For c = 0 To Scores(7)
For d = 0 To Scores(7)
CurrentScore = (Scores(a) + Scores(b) + Scores(c) + Scores(d))
ScoreDifference = ((TargetScore - CurrentScore) * (TargetScore - CurrentScore))
If ScoreDifference <= InitialScoreDifference Then
If ((Scores(a) <> Scores(b)) And (Scores(a) <> Scores(c)) And (Scores(a) <> Scores(d)) And (Scores(b) <> Scores(c)) And (Scores(b) <> Scores(d)) And (Scores(c) <> Scores(d))) Then
InitialScoreDifference = ScoreDifference
Console.WriteLine (Scores(a) & " " & Scores(b) & " " & Scores(c) & " " & Scores(d) & " " & ScoreDifference)
End If
End If
Next d
Next c
Next b
Next a
End Sub
When i run the code on visual studios it works fine and gives me the combination of 4 win/loss scores that will balance the teams. However when i run it on excel vba i keep getting : run-time error "9" subscript out off range
finally, i realise the algorithm im using is very inefficient and that i should be using a recursion algorithm for this kind of stuff, but i didnt really understand recursion so this was the next best thing
thank u for taking the time to read this
Upvotes: 1
Views: 90
Reputation: 149305
Console.WriteLine
is VB.Net Syntax. For VBA it is Debug.Print
like QHarr suggested.Integer
can hold signed 32-bit (4-byte) integers that range in value from 2,147,483,648
through 2,147,483,647
. In VBA Integer
can hold value from 32,768
to 32,767
. And hence it is advisable to use Long
in VBA.No need to declare an array and manully fill it. Declare a Variant
and fill the array at run time. For example
Dim Scores(0 To 7) As Long
Scores(0) = Worksheets("Sheet1").Cells(2, "D").Value
Scores(1) = Worksheets("Sheet1").Cells(3, "D").Value
Scores(2) = Worksheets("Sheet1").Cells(4, "D").Value
Scores(3) = Worksheets("Sheet1").Cells(5, "D").Value
Scores(4) = Worksheets("Sheet1").Cells(6, "D").Value
Scores(5) = Worksheets("Sheet1").Cells(7, "D").Value
Scores(6) = Worksheets("Sheet1").Cells(8, "D").Value
Scores(7) = Worksheets("Sheet1").Cells(9, "D").Value
can be written as
Dim Scores As Variant
Scores = Worksheets("Sheet1").Range("D2:D9").Value
and then you can use them as
CurrentScore = (Scores(a, 1) + Scores(b, 1) + Scores(c, 1) + Scores(d, 1))
To find the sum, again you do not need to loop though the array, you can directly find the sum of the range using Application.Evaluate
. For example
TotalScore = Application.Evaluate("=SUM(Sheet1!D2:D9)")
Hope this helps
Upvotes: 0
Reputation: 84465
In vba you can't write
Console.WriteLine (TotalScore)
Instead write
Debug.Print TotalScore
You should also declare Long
instead of Integer
to avoid overflow, put Option Explicit
at the top of your module and declare all your variables e.g.
As I think you are looping the whole array it is probably better to avoid hardcoding the bounds as you might increase the size of the array in the future so maybe, assuming you have a sheet called "Sheet1" in the currently ActiveWorkbook:
Option Explicit
Public Sub Main()
Dim TotalScore As Long
Dim TargetScore As Long
Dim CurrentScore As Long
Dim InitialScoreDifference As Long
Dim ScoreDifference As Long
TotalScore = 0
TargetScore = 0
CurrentScore = 0
InitialScoreDifference = 0
ScoreDifference = 0
Dim Scores(0 To 7) As Long
Scores(0) = Worksheets("Sheet1").Cells(2, "D").Value
Scores(1) = Worksheets("Sheet1").Cells(3, "D").Value
Scores(2) = Worksheets("Sheet1").Cells(4, "D").Value
Scores(3) = Worksheets("Sheet1").Cells(5, "D").Value
Scores(4) = Worksheets("Sheet1").Cells(6, "D").Value
Scores(5) = Worksheets("Sheet1").Cells(7, "D").Value
Scores(6) = Worksheets("Sheet1").Cells(8, "D").Value
Scores(7) = Worksheets("Sheet1").Cells(9, "D").Value
Dim x As Long
For x = LBound(Scores) To UBound(Scores)
TotalScore = TotalScore + Scores(x)
Next x
TargetScore = CLng(TotalScore / 2)
InitialScoreDifference = (TotalScore)
Debug.Print "TotalScore: " & TotalScore
Debug.Print "TargetScore: " & TargetScore
Debug.Print "InitialScoreDifference: " & InitialScoreDifference
Dim a As Long, b As Long, c As Long, d As Long
For a = LBound(Scores) To UBound(Scores)
For b = LBound(Scores) To UBound(Scores)
For c = LBound(Scores) To UBound(Scores)
For d = LBound(Scores) To UBound(Scores)
CurrentScore = (Scores(a) + Scores(b) + Scores(c) + Scores(d))
ScoreDifference = (TargetScore - CurrentScore) * (TargetScore - CurrentScore)
If ScoreDifference <= InitialScoreDifference Then
If ((Scores(a) <> Scores(b)) And (Scores(a) <> Scores(c)) And (Scores(a) <> Scores(d)) And (Scores(b) <> Scores(c)) And (Scores(b) <> Scores(d)) And (Scores(c) <> Scores(d))) Then
InitialScoreDifference = ScoreDifference
Debug.Print (Scores(a) & " " & Scores(b) & " " & Scores(c) & " " & Scores(d) & " " & ScoreDifference)
End If
End If
Next d
Next c
Next b
Next a
End Sub
Upvotes: 2