VBA code/Macro help to count the distances between numbers on a roulette wheel

[JanusValeri]

Hi all,
I could use some help. I am creating a predictor for roulette and I am trying to figure out a way to count the distance(s) between the winning number and the nearest number (in regards to the winning number) of the combination that I get from the predictor.

To better explain my question I have added a short video that shows my issue.

NOTE: So, in the video you see that the "winning number = 9", and the predictor creates three combinations to bet on.
In this case combo A gives 21 14 26 / combo B gives 24 17 29 / combo C gives 22 17 29:

1. Because in "combo A" the nearest number to "9" is 14, which is two pockets away (Distance = 2). So the result must be 2 in this case.
2. In "combo B" the nearest number to "9" is 29, which is three pockets away (Distance = 3). So the result must be 3 in this case.
3. In "combo C" the nearest number to "9" is 22, which is one pocket away (Distance = 1). So the result must be 1 in this case.

VEED - Distance roulette

Make stunning videos with a single click. Cut, trim, crop, add subtitles and more. Online, no account needed. Try it now, free. VEED

www.veed.io

I have no idea if this is possible. Any advice would be appreciated.


Thank you!

 

[Legacy 143009]

Can you provide the cell references for
- Where you put number 9
- Were are combo A, B, C cells?
- Where the results to be displayed?

 

[JanusValeri]

Hey Flashbond,

1. Number 9 is entered in cell Q50
2. In this example "combo A" is located in cells C45, D45 and E45; "combo B" is located in cells C46, D46 and E46; "combo C" is located in cells C47, D47 and E47
3. The results can be displayed in cell K45 for combo A; K46 for combo B; K47 for combo C.

Thanks!

 

[Legacy 143009]

Could you test it please?

Sub nearestDistance()

  Dim rNumbers As Variant
  Dim counter1 As Integer, counter2 As Integer, distances(3, 3) As Integer, smallest(3) As Integer
  Dim found As Boolean

  rNumbers = Split("0,26,3,35,12,28,7,29,18,22,9,31,14,20,1,33,16,24,5,10,23,8,30,11,36,13,27,6,34,17,25,2,21,4,19,15,32", ",")
 
  For r = 45 To 47
    For k = 3 To 5
      counter1 = 0
      counter2 = 0
      For j = 0 To UBound(rNumbers)
        found = False
        If CInt(rNumbers(j)) = Cells(50, 17).Value Then
          For i = j + 1 To UBound(rNumbers)
            counter1 = counter1 + 1
            If CInt(rNumbers(i)) = Cells(r, k).Value Then
              found = True
              Exit For
            End If
          Next
          If Not found Then
            For i = j - 1 To LBound(rNumbers) Step -1
              counter2 = counter2 + 1
              If CInt(rNumbers(i)) = Cells(r, k).Value Then
                Exit For
              End If
            Next
          End If
        distances(r - 45, k - 3) = IIf(found, counter1, counter2)
        End If
      Next
    Next
 
    For x = 0 To 1
      For y = x + 1 To 2
        If distances(r - 45, x) < distances(r - 45, y) Then
          smallest(r - 45) = distances(r - 45, x)
        Else
          smallest(r - 45) = distances(r - 45, y)
        End If
      Next
    Next

    Cells(r, 11).Value = smallest(r - 45)
  Next
End Sub

 

[JanusValeri]

Hey Flashbond, Thanks again for your wonderful help!

There's only an issue in row 47: in column K it gives "2" as an answer, but looking at the table number 22 is nearest to 9 (so the correct answer would need to return "1" as an answer) and now it thinks number 18 is nearest to 9.

I have two further questions if you don't mind:

1. If I would get a combo like "21, 14, 26, 5, 9", can the code return the answer "0" (as 9 itself is the closest number to the "winning number 9")?
2. Can you adjust the code to 6 combo's: so in the possibility that I would get 6 combo's instead of 3. In short, that I get combo's to show in rows 42 to 47 instead of from rows 45 to 47?

Thanks in advance!

 

[Legacy 143009]

How about this one:

Sub nearestDistance()
  Dim rNumbers As Variant
  Dim counter1 As Integer, counter2 As Integer, distances(6, 3) As Integer, smallest(6) As Integer
  Dim found As Boolean

  rNumbers = Split("0,26,3,35,12,28,7,29,18,22,9,31,14,20,1,33,16,24,5,10,23,8,30,11,36,13,27,6,34,17,25,2,21,4,19,15,32", ",")
 
  For r = 42 To 47
    For k = 3 To 5
      counter1 = 0
      counter2 = 0
      For j = 0 To UBound(rNumbers)
        found = False
        If CInt(rNumbers(j)) = Cells(50, 17).Value Then
          For i = j To UBound(rNumbers)
            If CInt(rNumbers(i)) = Cells(r, k).Value Then
              found = True
              Exit For
            End If
            counter1 = counter1 + 1
          Next
          If Not found Then
            For i = j To LBound(rNumbers) Step -1
              If CInt(rNumbers(i)) = Cells(r, k).Value Then
                Exit For
              End If
              counter2 = counter2 + 1
            Next
          End If
        distances(r - 42, k - 3) = IIf(found, counter1, counter2)
        End If
      Next
    Next
    smallest(r - 42) = distances(r - 42, 0)
    For s = 1 To 2
      If distances(r - 42, s) < smallest(r - 42) Then
        smallest(r - 42) = distances(r - 42, s)
      End If
    Next
    Cells(r, 11).Value = smallest(r - 42)
  Next
End Sub

 

[JanusValeri]

Wow this works perfect! Thanks for your amazing help.

One thing: Do you know why the code doesn't happen automatically?
Now after every new number I enter in "Q50" I need to right-click the sheet and go to "View Code" and hit the "Run Sub" button. I have placed this sub right after the previous code I got from you for counting unchanged cells. Maybe this has something to do with it?

You can see the two subs below each other in the attached image.

 

[Legacy 143009]

You can add the following into the previous Change Event:

If Not Intersect(Target, Range("Q50")) Is Nothing Then 'Or the cell address you change in order to modify Q50
  Application.EnableEvents = False
  Call nearestDistance
  Application.EnableEvents = True
End If

 

[JanusValeri]

l believe to have done something wrong with adjusting the code. So I entered your code above, but now both the "Change" and "nearestDistance" event don't update in their cells.
Maybe it has something to do with cell "Q50". Because I want that particular cell to be the one that activates both codes.

Here's the code that I now have:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("Q50")) Is Nothing Then 'Or the cell address you change in order to modify Q50
  Application.EnableEvents = False
  Call nearestDistance
  For i = 42 To 47
    If Cells(i, 9).Value = 1 Then
      Cells(i, 10).Value = Cells(i, 10).Value + 1
    Else
      Cells(i, 10).Value = 0
    End If
  Next
  Application.EnableEvents = True
  End If
End Sub

Sub nearestDistance()
  Dim rNumbers As Variant
  Dim counter1 As Integer, counter2 As Integer, distances(6, 3) As Integer, smallest(6) As Integer
  Dim found As Boolean

  rNumbers = Split("0,26,3,35,12,28,7,29,18,22,9,31,14,20,1,33,16,24,5,10,23,8,30,11,36,13,27,6,34,17,25,2,21,4,19,15,32", ",")
 
  For r = 42 To 47
    For k = 3 To 5
      counter1 = 0
      counter2 = 0
      For j = 0 To UBound(rNumbers)
        found = False
        If CInt(rNumbers(j)) = Cells(50, 17).Value Then
          For i = j To UBound(rNumbers)
            If CInt(rNumbers(i)) = Cells(r, k).Value Then
              found = True
              Exit For
            End If
            counter1 = counter1 + 1
          Next
          If Not found Then
            For i = j To LBound(rNumbers) Step -1
              If CInt(rNumbers(i)) = Cells(r, k).Value Then
                Exit For
              End If
              counter2 = counter2 + 1
            Next
          End If
        distances(r - 42, k - 3) = IIf(found, counter1, counter2)
        End If
      Next
    Next
    smallest(r - 42) = distances(r - 42, 0)
    For s = 1 To 2
      If distances(r - 42, s) < smallest(r - 42) Then
        smallest(r - 42) = distances(r - 42, s)
      End If
    Next
    Cells(r, 11).Value = smallest(r - 42)
  Next
End Sub

 

[Legacy 143009]

Interesting.. The code seems to be OK. Maybe Application.EnableEvents left False.
First run the code below once and then try to change Q50 again:

Sub test()
  Application.EnableEvents = True
End Sub

Also, the code must be in the same sheet with the data.