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

J

JanusValeri

New Member
Joined
Dec 6, 2022
Messages
20
Office Version
  1. 2019
Platform
  1. MacOS
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.
www.veed.io

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 www.veed.io

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


Thank you!
 
Sort by date Sort by votes
Works like a charm! 😊
Final question, if I want to adjust a small detail to the code: What if in the future I get a combo of five numbers "12 30 10 32 22". And the number in Q50 is "9".
The nearest number in this case is the fifth one "22". Where to adjust the code so I would get "1" as the answer?

Big thanks!
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
In the code r stands for row and k stands for column. The code should look like this. It will search through column C to G. I am posting without testing. Let me know if this works. If not, I can look at later.
VBA Code: 
Sub nearestDistance()
  Dim rNumbers As Variant
  Dim counter1 As Integer, counter2 As Integer, distances(6, 5) 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 7
      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)
        Exit For
        End If
      Next
    Next
    smallest(r - 42) = distances(r - 42, 0)
    For s = 1 To 4
      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
 
Upvote 0
Hey Flashbond, for some reason I keep getting an error message every time I test a new number.
I haven't changed anything to the code. The error stays the same: "Run-time error '13': Type mismatch".

Any idea why this happens?

VBA Code: 
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, 5) 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 7
      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 4
      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

I have only 1 sheet btw.
 

Attachments

  • Screenshot 2022-12-12 at 21.40.34.png
    Screenshot 2022-12-12 at 21.40.34.png
    45.1 KB · Views: 10
Upvote 0
That's because you have non numeric values. The workaround is difficult. Try something like this. I can not guarantee it will work:
VBA Code: 
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, 5) As Integer, smallest(6) As Integer
  Dim found As Boolean, isNumber 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 7
      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 IsNumeric(Cells(r, k).Value) Then
              isNumber = True
              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
            Else
            isNumber = False
            End If
          If isNumber Then
          distances(r - 42, k - 3) = IIf(found, counter1, counter2)
          End If
          Exit For
        End If
      Next
    Next
    If Not IsEmpty(distances(r - 42, 0)) Then
      smallest(r - 42) = distances(r - 42, 0)
    End If
    For s = 1 To 4
      If Not IsEmpty(distances(r - 42, s)) And 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
 
Last edited by a moderator:
Upvote 0
Flashbond said:
That's because you have non numeric values. The workaround is difficult. Try something like this. I can not guarantee it will work:
VBA Code: 
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, 5) As Integer, smallest(6) As Integer
  Dim found As Boolean, isNumber 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 7
      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 IsNumeric(Cells(r, k).Value) Then
              isNumber = True
              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
            Else
            isNumber = False
            End If
          If isNumber Then
          distances(r - 42, k - 3) = IIf(found, counter1, counter2)
          End If
          Exit For
        End If
      Next
    Next
    If Not IsEmpty(distances(r - 42, 0)) Then
      smallest(r - 42) = distances(r - 42, 0)
    End If
    For s = 1 To 4
      If Not IsEmpty(distances(r - 42, s)) And 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
Click to expand...
Thanks, I will try it out!
 
Upvote 0
Flashbond said:
That's because you have non numeric values. The workaround is difficult. Try something like this. I can not guarantee it will work:
VBA Code: 
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, 5) As Integer, smallest(6) As Integer
  Dim found As Boolean, isNumber 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 7
      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 IsNumeric(Cells(r, k).Value) Then
              isNumber = True
              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
            Else
            isNumber = False
            End If
          If isNumber Then
          distances(r - 42, k - 3) = IIf(found, counter1, counter2)
          End If
          Exit For
        End If
      Next
    Next
    If Not IsEmpty(distances(r - 42, 0)) Then
      smallest(r - 42) = distances(r - 42, 0)
    End If
    For s = 1 To 4
      If Not IsEmpty(distances(r - 42, s)) And 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
Click to expand...
Unfortunately, it doesn't work. Is there an alternative solution to this kind of issue?
 
Upvote 0
I know you asked for VBA code, but you could also use a fairly simple formula:

ABCDEFG
1PicksResultDistance
2A18112392
3B21142692
4C196398
5D21142692
6E24172993
7F229190
8
9Wheel
100
1126
123
1335
1412
1528
167
1729
1818
1922
209
2131
2214
2320
241
2533
2616
2724
285
2910
3023
318
3230
3311
3436
3513
3627
376
3834
3917
4025
412
4221
434
4419
4515
4632
47
Sheet1
Cell Formulas
RangeFormula
G2:G7G2=MIN(ABS(MATCH(C2:E2,Wheel,)-MATCH(F2,Wheel,)+{-37;0;37}))
Press CTRL+SHIFT+ENTER to enter array formulas.
Named Ranges
NameRefers ToCells
Wheel=Sheet1!$C$10:$C$46G2:G7
 
Upvote 0
StephenCrump said:
I know you asked for VBA code, but you could also use a fairly simple formula:

ABCDEFG
1PicksResultDistance
2A18112392
3B21142692
4C196398
5D21142692
6E24172993
7F229190
8
9Wheel
100
1126
123
1335
1412
1528
167
1729
1818
1922
209
2131
2214
2320
241
2533
2616
2724
285
2910
3023
318
3230
3311
3436
3513
3627
376
3834
3917
4025
412
4221
434
4419
4515
4632
47
Sheet1
Cell Formulas
RangeFormula
G2:G7G2=MIN(ABS(MATCH(C2:E2,Wheel,)-MATCH(F2,Wheel,)+{-37;0;37}))
Press CTRL+SHIFT+ENTER to enter array formulas.
Named Ranges
NameRefers ToCells
Wheel=Sheet1!$C$10:$C$46G2:G7
Click to expand...
Hey StephenCrump, thank you for your formula! Indeed, it doesn't have to be a VBA code.

But for some reason I can't paste the formula in my Excel sheet. It keeps giving me an error message. Does it have to do with me working on Mac instead of Windows?
I attached an image of the error message so you can see what I enter in the cells.

Thanks in advance.
 

Attachments

  • Formula problem.png
    Formula problem.png
    121.8 KB · Views: 10
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Calculating shortest to longest distances between Zip Codes (using latitude and longitude)
2 3
Replies
25
Views
2K
pawcoyote
P
S
  • Question Question
VBA Code- finding #Spill and moving the formula to the next column
Replies
0
Views
831
stromnoexcel
S
M
  • Question Question
VBA unplanned 1 to 7 numbers
Replies
5
Views
156
motilulla
M
L
  • Question Question
Formula Help with Count Number of Vessel Turnaround Trips monthly based on Criteria
Replies
1
Views
480
Lukma
L
J
  • Question Question
Count deadlines help
Replies
6
Views
600
juanam
J

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top