trjhtr

In my spare time I'm working on simulating a Rubik's Cube in excel using VBA:

So far I have code to rotate the top and the front of the cube. Currently I store the values of the left, back and bottom cubes on a hidden sheet called "Placeholder". I refer to the front, top and right side cubes on the sheet called "Main". I number each cube on the side 1-9. When I rotate a face of the cube, I rotate it clockwise and move the .Interior.Color to the corresponding cube, and because of this I have to occasionally store one of the values in a placeholdercube, which is just cell A1 on the sheet "Placeholder".

In order for the cube to have its look, I had to create right side triangles and carefully place them in each appropriate corner. Whenever I rotate a side, each triangle checks the color of it's responsible cell, then changes accordingly.

Right now it's a little clunky - so any tips would be appreciated!

Here is the code for rotating the front of the cube:

Sub RotateFront()
Application.ScreenUpdating = False
'Front rotation affects front, top, right, bottom and left
Dim frontcube1 As Range
Dim frontcube2 As Range
Dim frontcube3 As Range
Dim frontcube4 As Range
Dim frontcube5 As Range
Dim frontcube6 As Range
Dim frontcube7 As Range
Dim frontcube8 As Range
Dim frontcube9 As Range
Dim topcube7 As Range
Dim topcube8 As Range
Dim topcube9 As Range
Dim rightcube1 As Range
Dim rightcube4 As Range
Dim rightcube7 As Range
Dim bottomcube1 As Range
Dim bottomcube2 As Range
Dim bottomcube3 As Range
Dim leftcube3 As Range
Dim leftcube6 As Range
Dim leftcube9 As Range


Dim placeholdercube As Range
Dim numofturns As Range
Set placeholdercube = Worksheets("Placeholder").Range("A1")
Set numofturns = Worksheets("Main").Range("M16")

'cube layout:

'''''''''''''''''''''''''
' ' ' '
' cube1 ' cube2 ' cube 3'
' ' ' '
'''''''''''''''''''''''''
' ' ' '
' cube4 ' cube5 ' cube6 '
' ' ' '
'''''''''''''''''''''''''
' ' ' '
' cube7 ' cube8 ' cube9 '
' ' ' '
'''''''''''''''''''''''''

Set frontcube1 = Worksheets("Main").Range("B7") 'front3
Set frontcube2 = Worksheets("Main").Range("D7") 'front6
Set frontcube3 = Worksheets("Main").Range("F7") 'front9
Set frontcube4 = Worksheets("Main").Range("B10") 'front2
Set frontcube5 = Worksheets("Main").Range("D10") 'front5
Set frontcube6 = Worksheets("Main").Range("F10") 'front8
Set frontcube7 = Worksheets("Main").Range("B13") 'front1
Set frontcube8 = Worksheets("Main").Range("D13") 'front4
Set frontcube9 = Worksheets("Main").Range("F13") 'front7
Set topcube7 = Worksheets("Main").Range("C6") 'right1
Set topcube8 = Worksheets("Main").Range("E6") 'right4
Set topcube9 = Worksheets("Main").Range("G6") 'right7
Set rightcube1 = Worksheets("Main").Range("H7") 'bottom1
Set rightcube4 = Worksheets("Main").Range("H10") 'bottom2
Set rightcube7 = Worksheets("Main").Range("H13") 'bottom3
Set bottomcube1 = Worksheets("Placeholder").Range("C2") 'left3
Set bottomcube2 = Worksheets("Placeholder").Range("D2") 'left6
Set bottomcube3 = Worksheets("Placeholder").Range("E2") 'left9
Set leftcube3 = Worksheets("Placeholder").Range("E6") 'top7
Set leftcube6 = Worksheets("Placeholder").Range("E7") 'top8
Set leftcube9 = Worksheets("Placeholder").Range("E8") 'top9

'Rotate the front
placeholdercube.Interior.Color = frontcube9.Interior.Color
frontcube9.Interior.Color = frontcube3.Interior.Color
frontcube3.Interior.Color = frontcube1.Interior.Color
frontcube1.Interior.Color = frontcube7.Interior.Color
frontcube7.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = frontcube8.Interior.Color
frontcube8.Interior.Color = frontcube6.Interior.Color
frontcube6.Interior.Color = frontcube2.Interior.Color
frontcube2.Interior.Color = frontcube4.Interior.Color
frontcube4.Interior.Color = placeholdercube.Interior.Color
'frontcube5.Interior.Color = frontcube5.Interior.Color - No change

'Rotate the other pieces
placeholdercube.Interior.Color = rightcube1.Interior.Color
rightcube1.Interior.Color = topcube7.Interior.Color
topcube7.Interior.Color = leftcube3.Interior.Color
leftcube3.Interior.Color = bottomcube1.Interior.Color
bottomcube1.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = rightcube4.Interior.Color
rightcube4.Interior.Color = topcube8.Interior.Color
topcube8.Interior.Color = leftcube6.Interior.Color
leftcube6.Interior.Color = bottomcube2.Interior.Color
bottomcube2.Interior.Color = placeholdercube.Interior.Color
placeholdercube.Interior.Color = rightcube7.Interior.Color
rightcube7.Interior.Color = topcube9.Interior.Color
topcube9.Interior.Color = leftcube9.Interior.Color
leftcube9.Interior.Color = bottomcube3.Interior.Color
bottomcube3.Interior.Color = placeholdercube.Interior.Color

Dim piecearray As Variant, trianglearray1 As Variant, trianglearray2 As Variant, i As Long

piecearray = Array(topcube7, topcube8, topcube9, rightcube1, rightcube4, rightcube7)
trianglearray1 = Array(18, 24, 25, 3, 12, 15)
trianglearray2 = Array(30, 46, 36, 37, 42, 43)

For i = 0 To UBound(piecearray)

 'Change triangle pieces color
 If piecearray(i).Interior.Color = 255 Then 'red
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 0, 0)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 0, 0)
 End With

 ElseIf piecearray(i).Interior.Color = 5287936 Then 'green
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 176, 80)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 176, 80)
 End With

 ElseIf piecearray(i).Interior.Color = 12611584 Then 'blue
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 112, 192)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 112, 192)
 End With

 ElseIf piecearray(i).Interior.Color = 65535 Then 'yellow
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 255, 0)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 255, 0)
 End With

 ElseIf piecearray(i).Interior.Color = 49407 Then 'orange
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 192, 0)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(255, 192, 0)
 End With

 ElseIf piecearray(i).Interior.TintAndShade = 0 Then 'white
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.ObjectThemeColor = msoThemeColorBackground1
 .ForeColor.TintAndShade = 0
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.ObjectThemeColor = msoThemeColorBackground1
 .ForeColor.TintAndShade = 0
 End With
 End If

Next i

Range("A1").Select
'Increase number of turns by 1
numofturns.Value = numofturns.Value + 1
Application.ScreenUpdating = True
End Sub

Great concept and the presentation is very clunky. Let's see what we can do to make it easier to visualize and manipulate.

Working with the Shapes

There are several things that can be done to improve the If statement.

ElseIf piecearray(i).Interior.Color = 5287936 Then 'green
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 176, 80)
 End With
 ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).Select
 With Selection.ShapeRange.Fill
 .ForeColor.RGB = RGB(0, 176, 80)
 End With

Pseudo Code equivalent

If Range.Interior.Color = 5287936 then
 Triangle1.ForeColor.RGB = RGB(0, 176, 80)
 Triangle2.ForeColor.RGB = RGB(0, 176, 80)
End If

Sense RGB(0, 176, 80) evaluates = 5287936 we could simply say

 Triangle1.ForeColor.RGB = 5287936 
 Triangle2.ForeColor.RGB = 5287936 

It is better to work with the Shape directly instead of using the Selection object

ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray2(i))).RGB = 5287936

Even better would be to target both Shapes at once:

ActiveSheet.Shapes.Range(Array("Right Triangle " & trianglearray1(i), "Right Triangle " & trianglearray2(i))).RGB = 5287936

Another option would be to group each Cube's Triangles together and refer to them by their Group Name:

ActiveSheet.Shapes("Front Cube 4").Fill.ForeColor.RGB = vbYellow

The problem with using Active on Select is they target objects on the ActiveSheet. This can be avoided by fully qualifying the references:

Worksheets("Main").Shapes.Range(Array("Right Triangle " & trianglearray1(i), "Right Triangle " & trianglearray2(i))).RGB = 5287936

The part of the If statement that formats a Cube White does not have to be different.

 With Selection.ShapeRange.Fill
 .ForeColor.ObjectThemeColor = msoThemeColorBackground1
 .ForeColor.TintAndShade = 0
 End With

Simply Format your Range.Interior.Color to White.

Range.Interior.Color = vbWhite

This will allow you to remove the If statement all together:

Worksheets("Main").Shapes.Range(Array("Right Triangle 1", "Right Triangle 3")).Fill.ForeColor.RGB = piecearray(i).Interior.Color 

A With statement will make it easier to read:

With Worksheets("Main").Shapes.Range(Array("Right Triangle 1", "Right Triangle 3"))
 .Fill.ForeColor.RGB = piecearray(i).Interior.Color
End With