Category Archives: VBA

xlCubeSuper An Excel Game Explained – Part6

This article is Part6 of a detailed explanation of the parts that went into the making of my xlCube game.

Sub NewGame()

Over = False

IniVar

ClearBoard

DeleteOldCubes

AskForGameLevel

tdAddNamedRanges

MakeCubeMenu

End Sub

The routine AskForGameLevel was needed in the older version of this game, but adding 2 more cubes changed my mind about having this option, so it is now set to 7 in this version.

The routine tdAddNamedRanges was discussed in a previous post in this series.

 

Sub IniVar()

hint1Val = 0

hint2Val = 0

hint3Val = 0

hint4Val = 0

hint5Val = 0

hint6Val = 0

hint7Val = 0

End Sub

This procedure simply sets variables used in the hint portion of the menu.

Sub ClearBoard() ‘prepares the worksheets for another game (some code can be cleaned up here)

 

Application.ScreenUpdating = False

 

For Each wsh In Sheets

wsh.Unprotect

Next

 

Sheets(Array(“1”, “2”, “3”, “4”, “5”, “6”, “7”, “8”, “9”, “10”, “11”, “12”, “13”, “14”, “15”, _

“16”, “17”, “18”, “19”, “20”)).Select

 

Sheets(“1”).Activate

 

With Range(“board”)

.ClearContents

.Font.ColorIndex = 1

ActiveWindow.SelectedSheets.FillAcrossSheets Range:=Range(“board”), Type:=xlAll

End With

This changes the font color for all cells in the board back to black.

 

Range(“A21”).Select

Sheets(“10”).Select

 

For Each wsh In Sheets

If wsh.Name <> “Scores” Then

wsh.Protect

End If

Next

 

Application.ScreenUpdating = True

 

End Sub

 

Sub DeleteOldCubes()

On Error Resume Next

With ThisWorkbook

For d = 1 To 7

.Names(“cShip” & d).Delete

.Names(“centerShip” & d).Delete

Next

End With

End Sub

Since the center of each cube is a named range, they can easily be deleted by using the Names property.

 

Sub MakeCubeMenu() ‘creates menu for xlCube

Dim xlCubeMenu As CommandBarPopup

DeleteCubeMenu ‘ deletes menu if it exists

Set xlCubeMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, temporary:=True)

xlCubeMenu.Caption = “&xlCube”

Set nGameMenuItem = xlCubeMenu.Controls.Add(Type:=msoControlButton)

With nGameMenuItem

.Caption = “&New Game”

.OnAction = “NewGame”

End With

For h = 1 To 7

Set nHintMenuItem = xlCubeMenu.Controls.Add(Type:=msoControlButton)

With nHintMenuItem

If h = 1 Then

.BeginGroup = True

End If

.Caption = “Hint: xlCube &” & h

.Tag = “Hint” & h

.OnAction = HINT_MACRONAME

.Parameter = h

EDMenuItem h ‘procedure that disables specified menu item if the corresponding cube has been destroyed

End With

Next

Set scoresMenuItem = xlCubeMenu.Controls.Add(Type:=msoControlButton)

With scoresMenuItem

.BeginGroup = True

.Caption = “&Scores”

.OnAction = “TheScores”

.Parameter = “Scores”

End With

Set instructMenuItem = xlCubeMenu.Controls.Add(Type:=msoControlButton)

With instructMenuItem

.BeginGroup = True

.Caption = “&Instructions”

.OnAction = “TheScores”

.Parameter = “Instructions”

End With

Set aboutMenuItem = xlCubeMenu.Controls.Add(Type:=msoControlButton)

With aboutMenuItem

.BeginGroup = True

.Caption = “&About xlCube”

.OnAction = “AboutThisGame”

End With

End Sub

This procedure adds the custom menu. Since this is an “old-style” menu, it appears on the Add-ins section of the ribbon.

 

I hoped you have enjoyed this series of articles on how I built this game.

Advertisements

xlCubeSuper An Excel Game Explained – Part5

The main explanation text for this article is in black and bold font. This is the primary procedure used in xlCubeSuper. When a cell is clicked, something happens depending on where it is and what it contains. The original documentation for this procedure is highlighted in green and other procedures used are highlighted in blue. They will be discussed in Part6.

 

“Shooting” is accomplished by this event procedure.

 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

 

If Over Then Exit Sub ‘the Over variable is set to True when a game is finished

 

If ActiveSheet.Name = “Scores” Then Exit Sub ‘just in case you want to unhide this sheet

If Target.Font.ColorIndex > 1 Then Exit Sub ‘it already contains an “X”

If ActiveCell.Address <> Target.Address Then Exit Sub ‘if it is not a single cell selection

If Intersect(Range(“board”), Target) Is Nothing Then Exit Sub ‘if the selection is not on the board

 

Each of the 5 previous If-Then statement handle situations where the shot is not “correct”.

 

Calculate

NumOfHits = Application.WorksheetFunction.Sum(Range(“sumofhits”).Value) ‘hits before entry

On Error GoTo TheEnd

ActiveSheet.Unprotect

 

Target.Value = 1 ‘entry is made

This is prehaps the most important part of this procedure, although it looks very simple. It is, but adding a 1 to the cell does several things. First, it allows the formulas described in Part4 to keep track of all of the shots and hits. So, how does an X appear on the game board? Each cell has a custom format of “X”,,, which shows an X in the cell no matter what is entered.

 

Calculate

fShtPos = 0

TheRange = “”

 

The following loop checks to see whether the active cell is where any of the 7 centers of the cubes is located. If so, it will disable the hint in the menu associated with that cube and place a blue at that spot. Next, if the game is over (z=7) any hint costs will be summed and then added to the curent # of shots.

 

For p = 1 To 7

 

On Error Resume Next

 

tdRangeParse “centerShip” & p

 

If ActiveSheet.Name & Target.Address = fShtPos & TheRange Then ‘if a center of a cube has been hit

 

Target.Font.ColorIndex = 32

MsgBox “You just destroyed xlCube” & p & “!”, , “DESTROYED!”

Names(“cShip” & p).RefersTo = Range(“sums” & p).Value ‘changes name from reference to a value (# of hits)

Names(“centerShip” & p).Delete

Set cBar = Application.CommandBars.FindControl(Tag:=”Hint” & p)

cBar.Enabled = False ‘disables hint since corresponding cube is gone

 

For z = 1 To 7

 

If Mid(Names(“cShip” & z).RefersTo, 2, 1) = “‘” Then Exit For

 

If z = 7 Then

pScore = hint1Val + hint2Val + hint3Val + hint4Val + hint5Val + hint6Val + hint7Val ‘sums penalty score for hints

sScore = Range(“x15”).Value

fScore = pScore + sScore

MsgBox “The game is over! Your score is ” & fScore & “. ” & Chr(10) & Chr(13) & Level(fScore), , “GAME OVER!”

EnterInfo fScore

SortTable

ThisWorkbook.Save ‘saves changes made to records table

NewGame

Exit Sub

End If

 

Next

 

‘ActiveSheet.Protect

Exit Sub

End If

 

Next

If NumOfHits < Application.WorksheetFunction.Sum(Range(“sumofhits”).Value) Then

Target.Font.ColorIndex = 3 ‘turns red if hits > before event

End If

 

Finally, if the the shot is a hit, it will change the font color to red.

 

ActiveSheet.Protect

TheEnd:

End Sub

 

Although I have not explained every aspect of this procedure, I hope that this helps!

xlCubeSuper An Excel Game Explained – Part4

This is the 4th post to explain in detail how my xlCube game application was constructed. To read the previous post, go to:

https://dhexcel1.wordpress.com/2018/01/21/xlcubesuper-an-excel-game-explained-part3/

The number of hits is recorded by this formula

=SUM(BigBoard)

Where BigBoard is the 3D range representing the playing board.

The number of shots is recorded by this type of formula for each of the 7 cubes.

=IF(ISNA(ERROR.TYPE(cShip7)),SUM(cShip7),IF(ERROR.TYPE(cShip7)=5,0,SUM(cShip7)))

For explanation of the ERROR.TYPE function, see:

https://support.office.com/en-us/article/ERROR-TYPE-function-10958677-7c8d-44f7-ae77-b9a9ee6eefaa?NS=EXCEL&Version=16&SysLcid=1033&UiLcid=1033&AppVer=ZXL160&HelpId=xlmain11.chm60309&ui=en-US&rs=en-US&ad=US

See the figure for each area discussed.

 xlCS4_Board

The following formulas use the EVALUATE function, which is an old-style xlm macro function. It can only be used in a defined name formula. If you have noticed an issue opening the game application, this may be the cause. You would then have to place the file in a trusted location to open it. They are used in the conditional formatting of the 7 hits cells.

gbool1 =ERROR.TYPE(EVALUATE(“cShip”&ROW()-5))=5

This formula is really just there in case there is no ship center for that specific ship. Previously, the user was allowed to select the number of ships to be created, so this conditional formatting formula is really a legacy feature, not affecting the game functionality.

gbool2 =NOT(ISERROR(EVALUATE(“cShip”&ROW()-5)))

If the cell for cShip1 (in row 6) has a black color from conditional formatting, it means that this formula is TRUE, cShip1 does not exist. It has been destroyed.

The next post will focus on “taking a shot”.

 

 

 

xlCubeSuper An Excel Game Explained – Part3

This is the 3rd post to explain in detail how my xlCube game application was constructed. To read the previous post, go to:

https://dhexcel1.wordpress.com/2018/01/20/xlcubesuper-an-excel-game-explained-part2/

This is the VBA routine I developed to add 3D cube ranges to the playing board of xlCubeSuper. It generates 7 3D ranges randomly with sizes ranging from 3x3x3 to 15x15x15.

Sub tdAddNamedRanges()

Randomize ‘ Initialize random-number generator

For s = 1 To 7

‘set x,y, and z values to fall within limits determined by cube size

x = 1 + Int(Rnd() * (20 – (2 * s)))

y = 1 + Int(Rnd() * (20 – (2 * s)))

z = 1 + Int(Rnd() * (20 – (2 * s)))

‘create R1C1 style formula strings

cShipStr = “='” & z & “:” & z + (2 * s) & “‘!R” & x & “C” & y & “:R” & x + (2 * s) & “C” & y + (2 * s)

centerShipStr = “='” & z + s & “‘!R” & x + s & “C” & y + s

‘create names for cube 3D references and the centers of each cube

matchVar = False

With ThisWorkbook.Names

.Add Name:=”cShip” & s, RefersToR1C1:=cShipStr, Visible:=False

.Add Name:=”centerShip” & s, RefersToR1C1:=centerShipStr, Visible:=False

End With

If s > 1 Then

For m = 1 To s – 1

If Names(“centership” & m).RefersTo = Names(“centership” & s).RefersTo Then

matchVar = True

End If

Next

End If

If matchVar Then

s = s – 1

End If

Next

End Sub

The first statement in the VBA procedure uses RANDOMIZE to create a numeric seed that will be used by the RND function to generate a random number.

Inside the For-Next statement, which sets the variable “s” to a value from 1 to 7, the xyz coordinates for each cube are generated as follows:

x = 1 + Int(Rnd() * (20 – (2 * s)))

y = 1 + Int(Rnd() * (20 – (2 * s)))

z = 1 + Int(Rnd() * (20 – (2 * s)))

The numbers generated by these fomulas keep the cube on the board, depending on the value of “s”. The z coordinate is for the worksheets included in tne board and the xy coordinates are for the cells.

Then, for each value of “s”, the 3D cubical range and the center of each cube are generated with these formulas in R1C1 format.

cShipStr = “='” & z & “:” & z + (2 * s) & “‘!R” & x & “C” & y & “:R” & x + (2 * s) & “C” & y + (2 * s)

centerShipStr = “='” & z + s & “‘!R” & x + s & “C” & y + s

When they are saved as defined name formulas using the following code,

With ThisWorkbook.Names

.Add Name:=”cShip” & s, RefersToR1C1:=cShipStr, Visible:=False

.Add Name:=”centerShip” & s, RefersToR1C1:=centerShipStr, Visible:=False

End With

the formulas are converted by Excel into A1 format.

Originally, this was all of the code for this process. What I had ignored what the fact that two different cubes could have the exact same center. During all of the testing/playing of this game over the years, that scenario was never recognized as having occurred. But the current version, with 7 cubes, had this happen several times in early testing. So, I came up with this solution to correct this issue.

If s > 1 Then

For m = 1 To s – 1

If Names(“centership” & m).RefersTo = Names(“centership” & s).RefersTo Then

matchVar = True

End If

Next

End If

If matchVar Then

s = s – 1

End If

A key part to this code is

Names(“centership” & m).RefersTo = Names(“centership” & s).RefersTo

which compares the currently added formula to each previous formula added. If this statement is TRUE, then matchVar is set to TRUE. Then,

If matchVar Then

s = s – 1

End If

which decrements “s” by 1, effectively rerunning the previously generated 3D formula until an unique center is produced.

The next post will discuss the worksheet formulas used in this game.

 

 

 

 

 

xlCubeSuper An Excel Game Explained – Part1

I have just recently updated/modified my xlCube game that I first started on 20 years ago. The main modification is that it now has 7 cubes that must be destroyed before the game is over. For those who have never played the game, the previous version can be found at:

https://dhexcel1.wordpress.com/2016/11/29/xlcube-an-excel-game/

The new game is called xlCubeSuper. And, like the previous release, I encourage you to dig into the details of how this application was constructed. But, I know that your time is precious, and you may feel that this would not be an effective use of your Excel time. So, this time I am going to explain in detail all of the tricks and techniques used in the making of this game. In Part 1, I am only making it available to you. The explanation will come in subsequent posts. In the meantime, have fun with it.

You can download the file here.

xlcubeSuper

 

#Excel: Most Frequent Item in a List of Delimited Strings

 

rng is a defined name range on the worksheet with each cell containing delimited strings. Although it does not necessarily have to be a 1-column list, most examples of delimited strings in a range are of this type. To convert this range to an array, use the following formula.

Define arr as =ArrayFromCDS(TEXTJOIN(“,”,,rng))

where the VBA UDF is shown below.

Function ArrayFromCDS(MyString As String)

ArrayFromCDS = Split(MyString, “,”)

End Function

So, arr is a 1-D array of all of the delimited values from each cell of the range. Then, use this formula

=INDEX(arr,MODE(MATCH(arr,arr,0)))

to return the most frequent item.

#Excel Short and Sweet Tip #29: Inserting Icons Using a User-Defined Function

Disclaimer: You need the Excel version included in Office 365 for this technique to work.

The insertion of icons in Excel 2016 is accomplished from the ribbon by selecting Insert, Icons. There are a number of catagories to select from, as shown in ths figure.

MakeIcon1

However, recently I have been interested (obsessed?) with worksheet UDFs and their ability to invoke actions or shapes. In this case, I wanted to see if a UDF would insert an icon into the worksheet. This is the VBA function I made with help of the macro recorder. Place this in a general module in your worksheet.

Function MakeIcon(fName As String)

iString =        “https://hubblecontent.osi.office.net/ContentSVC/Content/Download?provider=MicrosoftIcon&amp;

fileName=” & fName & “.svg”

ActiveSheet.Pictures.Insert iString

End Function

Now, enter the formula =MakeIcon(“Man”) in cell A1 and you will get the following result.

MakeIcon

Unfortunately, there are several inherent Excel limitations that prevent the full utilization of this function. First, you have to know the correct name of the icon to produce it. It would be nice if Microsoft provided a list of the icon names, but I could not locate one. Then, I tried to get names by macro recording the insertion of multiple icons, but only the “last” selected icon URL is recorded. Even so, I hope that this technique is useful to you.

The example file can be downloaded here.

MakeIcon