paulked
06-17-2015, 05:19 AM
Hi
I have made up a sheet containing a grid of 4x5 hexagons to re-create the 1980's gameshow "Blockbusters".
For those of you young enough(and lucky enough!) not to remember it, it was a quiz for two teams (1 person v 2 people) answering questions to cross a grid.
I would like to detect when a team has won, ie crossed the grid.
I have put the grid into two arrays, one for crossing left to right, and one for top to bottom.
I started writing code using IF statements:
Sub MyAlgArray()
Dim A() As Variant
A = Sheet1.Range("i12:m15")
'Line across top
If A(1, 1) = 1 And A(1, 2) = 1 Or A(1, 1) = 1 And A(2, 2) = 1 Then
If A(1, 3) = 1 And A(2, 4) = 1 And A(2, 5) Then MsgBox "Equal"
If A(1, 3) = 1 And A(1, 4) = 1 Or A(1, 3) = 1 And A(2, 4) = 1 Then
If A(1, 5) = 1 Then MsgBox "Equal"
End If
End If
'2nd line
If A(2, 1) = 1 And A(2, 2) = 1 Or A(2, 1) = 1 And A(3, 2) = 1 Then
If A(2, 3) = 1 And A(2, 4) = 1 And A(1, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(3, 4) = 1 And A(3, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(2, 4) = 1 Or A(2, 3) = 1 And A(3, 4) = 1 Then
If A(2, 5) = 1 Then MsgBox "Equal"
End If
End If
'3rd line
If A(3, 1) = 1 And A(3, 2) = 1 Or A(3, 1) = 1 And A(4, 2) = 1 Then
If A(3, 3) = 1 And A(3, 4) = 1 Or A(3, 3) = 1 And A(4, 4) = 1 Then
If A(3, 5) = 1 Then MsgBox "Equal"
End If
End If
'4th line
If A(4, 1) = 1 And A(4, 2) = 1 Then
If A(4, 2) = 1 And A(3, 3) = 1 Or A(4, 2) = 1 And A(4, 3) = 1 Then
If A(4, 4) = 1 And A(3, 5) = 1 Or A(4, 4) = 1 And A(4, 5) = 1 Then MsgBox "Equal"
End If
End If
End Sub
As you can see, this has got very messy very quickly, and this is just for the basic right to left crossing.
Any ideas how this can be done more efficiently?
Best regards
Paul Ked
I have made up a sheet containing a grid of 4x5 hexagons to re-create the 1980's gameshow "Blockbusters".
For those of you young enough(and lucky enough!) not to remember it, it was a quiz for two teams (1 person v 2 people) answering questions to cross a grid.
I would like to detect when a team has won, ie crossed the grid.
I have put the grid into two arrays, one for crossing left to right, and one for top to bottom.
I started writing code using IF statements:
Sub MyAlgArray()
Dim A() As Variant
A = Sheet1.Range("i12:m15")
'Line across top
If A(1, 1) = 1 And A(1, 2) = 1 Or A(1, 1) = 1 And A(2, 2) = 1 Then
If A(1, 3) = 1 And A(2, 4) = 1 And A(2, 5) Then MsgBox "Equal"
If A(1, 3) = 1 And A(1, 4) = 1 Or A(1, 3) = 1 And A(2, 4) = 1 Then
If A(1, 5) = 1 Then MsgBox "Equal"
End If
End If
'2nd line
If A(2, 1) = 1 And A(2, 2) = 1 Or A(2, 1) = 1 And A(3, 2) = 1 Then
If A(2, 3) = 1 And A(2, 4) = 1 And A(1, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(3, 4) = 1 And A(3, 5) Then MsgBox "Equal"
If A(2, 3) = 1 And A(2, 4) = 1 Or A(2, 3) = 1 And A(3, 4) = 1 Then
If A(2, 5) = 1 Then MsgBox "Equal"
End If
End If
'3rd line
If A(3, 1) = 1 And A(3, 2) = 1 Or A(3, 1) = 1 And A(4, 2) = 1 Then
If A(3, 3) = 1 And A(3, 4) = 1 Or A(3, 3) = 1 And A(4, 4) = 1 Then
If A(3, 5) = 1 Then MsgBox "Equal"
End If
End If
'4th line
If A(4, 1) = 1 And A(4, 2) = 1 Then
If A(4, 2) = 1 And A(3, 3) = 1 Or A(4, 2) = 1 And A(4, 3) = 1 Then
If A(4, 4) = 1 And A(3, 5) = 1 Or A(4, 4) = 1 And A(4, 5) = 1 Then MsgBox "Equal"
End If
End If
End Sub
As you can see, this has got very messy very quickly, and this is just for the basic right to left crossing.
Any ideas how this can be done more efficiently?
Best regards
Paul Ked