xlCubeSuper7: An Unexpected Major Update – New Download – UDF Power

 

Due to some recent activity in the playing of this game, I started to think about any enhancements that would make the game easier to play. I realized that if a column was added to the scoring that showed the number of hits on each individual sheet for each cube, it would provide additional information to the player. So, my goal was to add that column, as shown in the figure below.

Initially, I thought that this would be a relatively simple task. However, I was wrong. The cube ships are laid out randomly as 3-D ranges. It is difficult or impossible to return the 2-D range associated with the 3-D range with normal worksheet formulas due to the limited ways to operate on 3-D ranges with worksheet functions. Thus, I realized that a UDF would be needed, since I did not want to modify the original programming. Then, I determined that the information that the UDF would require is:

1. The 3-D range reference string.
2. The “number” of the cube.
3. The position(s) of the desired information in a 3-D range reference string.
4. The first and last sheet of the 3-D range.
5. The 2-D range associated with the 3-D range.
6. The sheetname where it is being called from.

The complete code for the UDF is shown below.

Function SumSheetsHits()

Application.Volatile True

sRangeRaw = ThisWorkbook.Names(“cShip” & Application.Caller.Row – 5).RefersTo

sExclamation = Application.Find(“!”, sRangeRaw)

sColon = Application.Find(“:”, sRangeRaw)

sTick = InStr(sColon, sRangeRaw, “‘”)

If sColon = 4 Then

iFirst = Val(Mid(sRangeRaw, 3, 1))

Else

iFirst = Val(Mid(sRangeRaw, 3, 2))

End If

If sTick – sColon = 2 Then

iSecond = Val(Mid(sRangeRaw, sColon + 1, 1))

Else

iSecond = Val(Mid(sRangeRaw, sColon + 1, 2))

End If

aSheetNum = Val(ActiveSheet.Name)

srange = Mid(sRangeRaw, Application.Find(“!”, sRangeRaw) + 1, 255)

If aSheetNum < iFirst Or aSheetNum > iSecond Then

Else

SumSheetsHits = Application.Sum(ActiveSheet.Range(srange))

End If

End Function

So, the function =SumSheetsHits() is entered in column Y beginning on row 6. The line of code ThisWorkbook.Names(“cShip” & Application.Caller.Row – 5).RefersTo returns the 3-D formula string for cube 1 when entered in Y6. Application.Caller.Row is in row 6 in this example, so ThisWorkbook.Names(“cShip” & 6 – 5).RefersTo cShip1 and returns “ =’6:8’!$B$5:$D$7 “ which is the 3x3x3 cube 3-D reference.

Next, the 3 important characters for finding the desired information in the string are located. Note that both the FIND function and the InStr function are to find those positions, but really the InStr function could have been used for all 3 lookups.

sExclamation = Application.Find(“!”, sRangeRaw)

sColon = Application.Find(“:”, sRangeRaw)

sTick = InStr(sColon, sRangeRaw, “‘”)

The variable sTick shows the location of the 2^nd tick in the string, since the search is made after the colon.

In order to find the first sheetname in the string (which by definition is a 1 or 2 digit number), this simple if, End if logic block of code is used.

If sColon = 4 Then

iFirst = Val(Mid(sRangeRaw, 3, 1))

Else

iFirst = Val(Mid(sRangeRaw, 3, 2))

End If

Note the use of the Val function, which converts the numeric string to an actual number. The find the second sheetname, the difference of sTick and sColon are used to define whether a 1 or 2 digit number is used.

If sTick – sColon = 2 Then

iSecond = Val(Mid(sRangeRaw, sColon + 1, 1))

Else

iSecond = Val(Mid(sRangeRaw, sColon + 1, 2))

End If

The sheetname is returned by the following code.

aSheetNum = Val(ActiveSheet.Name)

Since (fortuitously) the sheet names are consecutive numbers, that information makes the job of bounding the 3-D range much easier.

The 2-D range part of the formula is:

srange = Mid(sRangeRaw, Application.Find(“!”, sRangeRaw) + 1, 255)

and it is used with the final block of code.

If aSheetNum < iFirst Or aSheetNum > iSecond Then

Else

SumSheetsHits = Application.Sum(ActiveSheet.Range(srange))

End If

 

Since the 3-D range is bounded by these 2 sheets, any sheets outside would not be capable of recording any hits on this ship.

You might question the use of the SUM function here, when a hit on a ship appears as an “X”. Actually, when a shot is made, a 1 is placed in the cell, and the appearance of the “X” occurs through custom fomatting.

xlCubeSuper is now available with this new game functionaity, and can be downloaded by clicking the following link.

xlcubeSuper

 

 

 

Excel Filter and Sort UDFs – Amazing!

 

 

In late September 2018, Microsoft revealed a number of fascinating new Excel worksheet functions.

https://techcommunity.microsoft.com/t5/Excel-Blog/Preview-of-Dynamic-Arrays-in-Excel/ba-p/252944

Bill Jelen has churned out an amazing 66-page ebook on the new functions.

https://www.mrexcel.com/download-center/books/2018/ExcelDynamicArraysStraightToThePoint.pdf

I strongly recommend that you look at the links listed above. Only then will you be able to appreciate what is presented in this article.

But, I don’t have immediate access to looking at these functions in the newest versions of Excel. So, that started me thinking: Could something similar to this work in a user-defined function (UDF)? My latest UDF creation, along with links to other interesting uses of UDFs can be viewed here.

https://dhexcel1.wordpress.com/2018/05/26/excel-generate-a-list-of-antonyms-using-an-user-defined-function-udf/

Well, to make a long story short, it can and furthermore they operate on the ORIGINAL DATA. This means they can filter a dataset in place and sort data in place instead of creating a duplicate dataset or subset like the new Excel functions do. You may ask how a UDF, entered in a worksheet cell remote for the data, can filter and/sort that table of data, and even I did not think that it was possible, or I would have exploited this long ago.

So, the FILTERFUN function presented here (I would have called it FILTER but I would not want it to conflict with the new Excel functions if used alongside them) can filter a table of data. In the figure shown below, the FILTERFUN function is shown along with a set of data. This UDF has 2 arguments, the field in the table to be filtered and the criteria to be used for the filter.

 

If you are familiar with using Excel’s advanced data filter, you will note that the criterial in the 2^nd argument uses the same syntax and has wildcard filtering abilities. The result for entering this formula can be seen in the next figure.

 

The code for the FILTERFUN function fixes the location for the table to start in cell A1, but that can easily be modified, as can be seen in the code for the next magical UDF, the SORTFUN function.

This UDF has 3 arguments: the table range, the field to be used as the sort key, and the desired sort order, as shown:

 

In this case, when the SORTFUN function is entered, the desired sort of the table is performed.

The following code for both of these functions is shown below.

 

These functions provide a utility that can be made to mostly emulate the new Excel FILTER and SORT functions, while also allowing the desired result without creating new data tables.

 

I hope you find this technique useful. If so, share it with your Excel friends and colleagues.

The Excel file can be downloaded here:

FFunction

 

 

 

 

#Excel: Generate a List of Antonyms Using an User-Defined Function (UDF)

It really is amazing what you can do with an Excel user-defined function (UDF). Here is a list (not comprehensive) of articles from my website that demonstrate clever and unusual uses of UDFs.

https://dhexcel1.wordpress.com/2017/07/12/excel-short-and-sweet-tip-26-showing-an-userform-with-a-worksheet-udf-by-david-hager/

https://dhexcel1.wordpress.com/2017/07/07/excel-short-and-sweet-tip-25-playing-a-random-sound-with-a-worksheet-udf-by-david-hager/

https://dhexcel1.wordpress.com/2017/07/01/automating-word-and-powerpoint-from-excel-with-a-worksheet-udf-by-david-hager/

https://dhexcel1.wordpress.com/2017/06/19/excel-short-and-sweet-tip-23-open-windows-file-explorer-with-worksheet-udf-by-david-hager/

https://dhexcel1.wordpress.com/2017/06/07/excel-exchange-rate-udf-with-symbol-lookup-by-david-hager/

https://dhexcel1.wordpress.com/2017/06/03/creating-an-excel-translator-by-david-hager/

https://dhexcel1.wordpress.com/2017/05/23/excel-udf-using-google-api-to-return-the-elevation-of-an-address-by-david-hager/

https://dhexcel1.wordpress.com/2017/05/12/excel-creating-a-udf-with-the-vba-environ-function-and-using-it-to-make-a-table-of-environmental-variables-by-david-hager/

https://dhexcel1.wordpress.com/2017/04/29/excel-worksheet-udf-that-adds-a-comment-to-any-cell-by-david-hager/

https://dhexcel1.wordpress.com/2017/04/19/excel-modifying-shapes-from-an-udf-in-a-worksheet-cell-by-david-hager/

In this article, I will show how to use an Excel UDF to return a delimited string of antonyms. It uses Word VBA, so in order for the code to work, you must add a reference to the Microsoft Word Object library in the VBE, as shown below.

Then, the following code for the UDF can be placed in a general module in the VBE.

Function AllAntonyms(TheWord As String)

Dim Alist

Alist = SynonymInfo(Word:=TheWord, LanguageID:=wdEnglishUS).AntonymList

For i = 1 To UBound(Alist)

If i = UBound(Alist) Then

DList = DList & Alist(i)

Else

DList = DList & Alist(i) & “,”

End If

Next

AllAntonyms = DList

End Function

The result for using this UDF in a worksheet cell with the word “excited” as the lookup for antonyms in shown in the following figure.

There are a number of possibilties for extending/modifying this example to other useful UDFs. I hope that you find this useful in that regard.

You can download the workbook here.

 

Thesaurus

 

 

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.

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.

 

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 3^rd 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.

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.

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

Generating a “Realtime” Voice Alert for the Latest Magnitude 5 or Greater Earthquake

 

I recently published an article about getting information on the latest earthquake of magnitude 5 or greater.

https://dhexcel1.wordpress.com/2017/07/10/getting-the-latest-earthquake-alert-using-the-webservice-and-filterxml-functions-in-excel-by-david-hager/

Please read this article to see how the core model was constructed.

One problem with this model is that since Excel’s web functions are non-volatile, a formula containing those functions must be recalculated by reentering the formula. I decided that an easier way was needed to trigger an update. I also recently published an article which utilized the hyperlink rollover technique.

https://dhexcel1.wordpress.com/2017/09/15/highlighting-words-in-an-excel-list-using-the-hyperlink-rollover-method/

I figured that this might be a good way to trigger a recalculation. And, since I was going to use a VBA function to be called from the hyperlink formula, I thought that adding audio functionality would be useful as well. Here is the hyperlink rollover formula used (in cell D5, named Recalculate). Since a rollover is required, the technique is not truly realtime.

=IFERROR(HYPERLINK(EarthQuakeAlert(),”Recalculate”),”Recalculate”)

And, here is the VBA function called by “rolling over” (passing the cursor over) that cell.

Function EarthQuakeAlert(Optional Person As String = “Him”, _

Optional Rate As Long = 1, Optional Volume As Long = 80)

Static xlApp As New Excel.Application

Dim Voc As SpeechLib.SpVoice

Set Voc = New SpVoice

Dim sAddress As String

‘Application.Volatile True

xlApp.CalculateFull

If Range(“d1”).Value = Range(“b3”).Value Then

MsgBox “No new earthquake > 5.0”

Else

With Voc

If Person = “Him” Then

Set .voice = .GetVoices.Item(0) ‘male

ElseIf Person = “Her” Then

Set .voice = .GetVoices.Item(1) ‘female

Else

End If

.Rate = Rate

.Volume = Volume

.Speak “New Earthquake Alert! ” & Range(“b5”).Value

End With

Range(“d1”).Value = Range(“b3”).Value

End If

EarthQuakeAlert = “Recalculate”

Set xlApp = Nothing

End Function

In order to use SpeechLib.SpVoice in the code, the correct reference (from Tools, References) must be added to the VBE as shown in the following figure.

In this figure is a picture of the earthquake model.

I hope that you find this useful. You can download the file here.

earthquake_audio­_alert

Excel Super Links 1-150

This time you really hit the jackpot! >850 Excel and Power BI Links, all of the best articles. Make this the cornerstone of your Excel resource library. Download the Word document here.

Excel Super Links 1-150

 

 

Adding Multiple DAX Measures to Non-PowerPivot Versions of #Excel using an User-Defined VBA Function

 

 

In this article,

http://dailydoseofexcel.com/archives/2017/07/10/look-ma-no-powerpivot/

Jeff Weir pointed to a video made by Mike Girvin about adding measures to non-PowerPivot versions of Excel (link below)

https://www.youtube.com/watch?v=FVVK-8QZC1M&t=422s

Mike demonstrated how measures can be added to a data model in these “disabled” version through pivot table options. Please view this video to see how Mike did it.

The link to the working file for this video will be referred to in this article (Thanks, Mike!).

https://people.highline.edu/mgirvin/YouTubeExcelIsFun/EMT1269Finished.xlsx

You can download this file and reproduce the technique presented here.

Although it is not well-known, Microsoft started at Excel version 2016 (Office 365) marketing versions that do not have PowerPivot capability. For details on this, see:

https://blogs.office.com/en-us/2015/09/18/new-ways-to-get-the-excel-business-analytics-features-you-need/

So, this article is dedicated to those who purchased non-PowerPivot versions of Excel 2016, although the technique presented here will work on any version of Excel 2013 or greater.

Jeff Weir mentioned in his article that since some Excel 2016 versions did not have the full-blown PowerPivot capability, and that VBA could be used to build a user interface to the data model. Well, I have not created a UI, but I have made a way to add multiple measures to the data model using an user-defined function. The code for the VBA function is shown below. To use this, add astandard module in the VBE and then save the workbook as .xlsm. Then, copy/paste the code into the module.

 

Function AddMeasure(TableName As String, MeasureName As Range)

Application.Volatile False

With ActiveWorkbook.Model

For Each mCell In MeasureName

mFormat = mCell.Offset(0, 2).Value

.ModelMeasures.Add mCell.Value, .ModelTables(TableName), mCell.Offset(0, 1).Value, _

Switch(mFormat = “Boolean”, .ModelFormatBoolean, mFormat = “Currency”, .ModelFormatCurrency, _

mFormat = “Date”, .ModelFormatDate, mFormat = “DecimalNumber”, .ModelFormatDecimalNumber, _

mFormat = “General”, .ModelFormatGeneral, mFormat = “PercentageNumber”, .ModelFormatPercentageNumber, _

mFormat = “ScientificNumber”, .ModelFormatScientificNumber, mFormat = “WholeNumber”, .ModelFormatWholeNumber), _

mCell.Value

Next

End With

AddMeasure = “DONE”

End Function

Then, place the following information in the range D10:F14.

 

NetRevenue	SUMX(fTransactions,ROUND(RELATED(dProducts[Price])*fTransactions[Units]*(1-fTransactions[Discount]),2))	DecimalNumber
MaxRevenue	MAXX(fTransactions,ROUND(RELATED(dProducts[Price])*fTransactions[Units]*(1-fTransactions[Discount]),2))	PercentageNumber
MinRevenue	MINX(fTransactions,ROUND(RELATED(dProducts[Price])*fTransactions[Units]*(1-fTransactions[Discount]),2))	Currency
AverageRevenue	AVERAGEX(fTransactions,ROUND(RELATED(dProducts[Price])*fTransactions[Units]*(1-fTransactions[Discount]),2))	General
CountOfRevenue	COUNTAX(fTransactions,ROUND(RELATED(dProducts[Price])*fTransactions[Units]*(1-fTransactions[Discount]),2))	General

 

To run this as a worksheet formula, type this formula in any cell.

=AddMeasure(“fTransactions”,D10:D14)

This will add the 5 measures to the data model, as shown in the Pivot Table Fields list.

After the 5 measures are added to the pivot table, the resulting pivot table will look like this.

Of course, the DAX formulas to be added have to return valid results, or the procedure will fail.

This powerful technique is yet another reason why users should not completely abandon Excel for Power BI desktop, as discussed in this article at powerpivotpro.com

https://powerpivotpro.com/2017/09/excel-is-still-the-best-tool-for-teaching-dax/

And, this technique does not HAVE to be run from a UDF, but I am still amazed that it can. I am sure that you will find this very useful.

#Excel Impossibly Easy #2: Change Sheet Tab Color with a User-Defined Worksheet Formula

What if I told you that I wanted to change tab colors on sheets in a workbook by entering a formula (UDF) on a worksheet. Impossible, right? No, it turns out that it is “easy”.

This simple UDF (code shown below) can be entered on a worksheet and the desired worksheet tab will change to any color you want.

Function ChangeTabColor(sht As String, RED_Color As Integer, GREEN_Color As Integer, BLUE_Color As Integer)

With ActiveWorkbook.Sheets(sht).Tab

.Color = RGB(RED_Color, GREEN_Color, BLUE_Color)

End With

End Function

For example, entering this formula in a cell will turn the tab on Sheet1 red.

=ChangeTabColor(“Sheet1”,255,0,0)

This figure shows the result in the example workbook of entering two cells. Note that the UDF does not have to be entered on the worksheet whose tab color is changed.

I have added a worksheet that has a list of colors along with their respective RGB codes for your convenience. I am sure that you will come up with many novel ways to use this technique.

The example file can be downloaded here.

TabColor

#Excel Impossibly Easy #1: Return a 1D Array from Non-Contiguous Native 3D Ranges

 

What if I told you that I had 2 non-contiguous 3D ranges in an Excel workbook and I wanted to return a single 1D array from those ranges. Impossible, right? No, it turns out that it is “easy”.

Prior to the introduction of the TEXTJOIN function, this would likely have been impossible. But, this function accepts native 3D ranges as range arguments. See:

https://dhexcel1.wordpress.com/2017/05/23/excel-native-3d-ranges-with-the-textjoin-function-plus-bonus-by-david-hager/

It would have been nice if the technique was only a VBA solution, but although Textjoin is a VBA worksheet function in Excel, VBA will not accept a native 3D range as an argument. Likewise, a pure Excel formula solution would have been nice, and a method dows exist to do this

https://dhexcel1.wordpress.com/2017/02/07/calculating-aggregation-for-internal-numbers-from-strings-in-a-range-by-david-hager/

but it has severe limitations which prevents its use with a relatively large number of cells (maybe 150). The total number of characters that a cell can contain is 32,767 characters. This solution assumes that an average of 6 characters per cell plus a comma for each gives an approximate number of 4500 cells allowed.

Here is the solution.

=ArrayFromCDS(TEXTJOIN(“,”,TRUE,Sheet1:Sheet3!$B2:$D$6,Sheet1:Sheet3!$G$2:$G$6))

It consists of the TEXTJOIN worksheet function with 2 non-contiguous 3D ranges arguments

TEXTJOIN(“,”,TRUE,Sheet1:Sheet3!$B2:$D$6,Sheet1:Sheet3!$G$2:$G$6)

And a simple VBA function which converts a comma delimited string into a 1D array.

Function ArrayFromCDS(MyString As String)

ArrayFromCDS = Split(MyString, “,”)

End Function

In the example file, the array produced contains all of the elements of the two 3D ranges (shown below).

{“Name1″,”Name2″,”Name3″,”Name4″,”Name2″,”Name3″,”Name7″,”Name2″,”Name3″,”Name10″,”Name2″,”Name3″,”Name13″,”Name2″,”Name3″,”Name1″,”Name2″,”Name3″,”Name4″,”Name2″,”Name3″,”Name7″,”Name2″,”Name3″,”Name10″,”Name2″,”Name3″,”Name13″,”Name2″,”Name3″,”Name1″,”Name2″,”Name3″,”Name4″,”Name2″,”Name7″,”Name7″,”Name2″,”Name11″,”Name10″,”Name2″,”Name15″,”Name13″,”Name2″,”Name19″,”a”,”b”,”c”,”d”,”a”,”b”,”d”,”e”,”b”,”d”,”e”,”f”,”m”,”e”,”f”}

The figure shows this formula in cell I2.

I hope that you will find this useful.

The example file can be downloaded here.

TJ_3dTo1dArray

Bible Verse In Any Language Using #Excel by David Hager

 

I recently demonstrated what became a popular Excel technique – looking up a Bible verse using Excel’s web functions. On LinkedIn, I received a comment from Raul stating that he did not understand English, only Spanish. So, I decided to add language translating to the model. I tried to find a (free) way to do this directly from an API, but I could not. I turned instead to the translation technique I had already published which use a VBA procedure. I combined both of the methods as demonstrated in the links shown below.

https://dhexcel1.wordpress.com/2017/06/03/creating-an-excel-translator-by-david-hager/

https://dhexcel1.wordpress.com/2017/07/03/lookup-a-bible-verse-using-excel-wo-vba-by-david-hager/

You can read both of these articles to see the details of how each was constructed. Meanwhile, the key formula in cell H5 is:

=Translate(mString,LangCode)&T(NOW())

where mString = IF(ISERROR(FIND(“/b>”,oString)),oString,MID(oString,FIND(“/b>”,oString)+3,255))

and oString = FILTERXML(WEBSERVICE(“http://labs.bible.org/api/?passage=”&TheBook&&#8221; “&TheChapter&”:”&TheVerse&”&type=xml”),”//text”)

and LangCode = INDEX(LanguageCodes,MATCH(Language,LanguageNames,0))

Use the dropdowns in H2:J2 to select verse and language.

Sometimes the query has to be run twice in order to work. I have not been able to solve this problem, so please run the query a 2^nd time if the cell containing the verse is blank. Alternatively, if you click in the formula in H5 and press Enter, it should calculate as desired. The problem is likely due to the Excel web functions becoming confused during recalculation. I attempted to correct this by adding &T(NOW()) to the end of the formula in cell H5. It appeared to help, but I cannot guarantee it. You can also try pressing Ctrl-Alt-F9 for recalculation.

This should be useful to everyone worldwide.

You can download the file here.

BibleVerseMultLanguages

#Excel Short and Sweet Tip #26 (Showing an UserForm With a Worksheet UDF) by David Hager

 

When looking at the vagaries of a Worksheet UDF, it appeared to me that anything viewed by Excel as an object could be invoked by the UDF. So, I thought, what is a large Excel object that may not work with this methodology? After a while, I thought of an Userform. Surely, I cannot show an Userform in this way. But, I WAS WRONG!

Open a new workbook and go to the Visual Basic Editor (VBE) and add an Userform. Then, add a standard module and add this code to it.

Function UForm()

UserForm1.Show

End Function

Then enter this formula in cell A1.

=UForm()

And presto, the userform appears!

Obviously, any userform, including those of your elaborate design, can be shown in this way. To have this UDF run when a specific cell is recalculated (in this case, A2), you can use a formula like:

=A2&UForm()

as shown in the following figure:

Have fun with this!

#Excel Short and Sweet Tip #25 (Random Sound – Worksheet UDF) by David Hager

 

Once again, I am borrowing from an Excel technique from John Walkenbach, in this case playing a .wav file in Excel.

http://spreadsheetpage.com/index.php/tip/playing_sound_from_excel/

I have modified his code by coverting it to a function procedure with one argument for running a specified wav file. Copy into a module in the VBE.

Private Declare Function PlaySound Lib “winmm.dll” _

Alias “PlaySoundA” (ByVal lpszName As String, _

ByVal hModule As Long, ByVal dwFlags As Long) As Long

Const SND_SYNC = &H0

Const SND_ASYNC = &H1

Const SND_FILENAME = &H20000

Function PlayWAV(fName As String)

PlayWAV = “”

WAVFile = fName & “.wav”

WAVFile = ThisWorkbook.Path & “\” & WAVFile

Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME)

End Function

This procedure assumes that the wav files to be played are in the same folder as the workbook.

In order to play a random sound, I made these 2 defined name formulas.

soundlist ={“chicken”,”horse”,”kitten”,”owl”,”cow”}

rand_sound =INDEX(soundlist,INT(RAND()*COUNTA(soundlist))+1)

So, the .wav files starting with, in this example, (chicken, horse, kitten, owl and cow) must exist for this function to work. You must personalize this array so that this technique will work with your own wav files.

Now, enter this function in a worksheet cell

=PlayWAV(rand_sound)

Each time that the worksheet is recalculated, a random sound will play. I hope that you will find this useful.

Automating Word and PowerPoint from #Excel with a Worksheet UDF by David Hager

 

I have been following Mark’s recent posts at https://exceloffthegrid.com/ about automation from Excel.

https://exceloffthegrid.com/controlling-word-from-excel-using-vba/

https://exceloffthegrid.com/controlling-powerpoint-from-excel-using-vba/

That got me thinking about the use of user-defined functions in automating/instatiating other applications.

As it turns out, I first demonstrated the ability of user-defined functions to be used in automating an app (in this case Mappoint) in 2005 in this article on Dick Kuseika’s web site.

http://dailydoseofexcel.com/archives/2005/04/25/automating-mappoint/

In the comments of this article, Jan Karel Pieterse (http://www.jkp-ads.com/ ) showed that the same thing could be done with Microsoft Word. I am using his example here to show that it does work.

Here is the code:

Function WriteResultToWord(stest As String)

Dim oWdObj As New Word.Application

Application.Volatile False

oWdObj.Visible = True

oWdObj.Documents.Add

oWdObj.ActiveDocument.Paragraphs.First.Range.InsertAfter ” ” & stest

End Function

The result of entering this formula in cell E2 (=WriteResultToWord(D1)) is to open Word and insert the text into the blank document, shown in the following figure.

The next step was to find out if this technique would work with any other application. To test this on Power Point, I used this great example from Chandoo’s site.

http://chandoo.org/wp/2011/08/03/create-powerpoint-presentations-using-excel-vba/

I simply changed the Sub routine to a Function, with little modification (see code in the example file).

So, entering =AddChartsPowerPoint() in a cell opens Power Point and adds two charts (see below).

In this article I shared the technique of automation using a UDF. I am sure that you will extend these ideas in your own work.

Here is the example file.

AutomateUDF

Great #Excel Technique: August 2017 Total Eclipse Info by David Hager

 

In case you have not heard, on August 21, 2017, a total eclipse shadow is going to stretch across the entire United States. And, the rest of the U.S. will experience a partial eclipse of vaying degree based on the specific location.

This workbook will direct you to information for a specified location at timeanddate.com for the August 2017 total eclipse of the sun.

It is important to note that this workbook does not in any way purport to access or create any information about the eclipse directly. Rather, it uses a link to the web site following the guidelines of the disclaimer to open a web page with the specified eclipse information.

https://www.timeanddate.com/information/disclaimer.html

The creation of the list lookups used in this example were discussed in this recent article.

https://dhexcel1.wordpress.com/2017/06/22/creating-dependent-lists-from-a-column-lookup-in-an-excel-list-by-david-hager/

Please review that article to see how the control cells C3 and D3 work. When the state is selected in C3, the list in D3 is populated with the desired city. When both are selected, in cell D1 (named The DesiredLink) the array formula:

=INDEX(EclipseLink,MATCH(TheCityName&TheStateName,City&State,0))

which looks up the eclipse link for that state and city.

When the CommandButton is clicked, the following procedure in the Control worksheet module is run.

 

Private Sub GetEclipseInfo_Click()

ActiveWorkbook.FollowHyperlink Address:=Range(“TheDesiredLink”).Value

End Sub

 

This procedure uses the correct link to access the eclipse web site for the specified statye and city, which is opened in your browser. Hoper that you enjoy this, and the eclipse.

You can download the file here.

2017_Eclipse

#Excel Super Links #75 – shared by David Hager

 

Getting A Handle On Userforms [VBA]

https://colinlegg.wordpress.com/2016/05/06/getting-a-handle-on-userforms-vba/

Excel VBE Options

http://www.excelgaard.dk/Lib/VBE/Options/

Excel Solution: Who Should Sit Where?

http://datascopic.net/seating/?doing_wp_cron=1497911478.3255810737609863281250

Basket Analysis in DAX

http://www.daxpatterns.com/basket-analysis/

Excel Short & Sweet Tip #6 (Shuffling a String) by David Hager

https://dhexcel1.wordpress.com/2017/04/25/excel-short-sweet-tip-6-shuffling-a-string-by-david-hager/

 

#Excel Short and Sweet Tip #23 (Open Windows File Explorer with Worksheet UDF) by David Hager

 

When collecting new links to publish in my Excel Super Links series, I try not to reuse the link in another article. I have been using Windows Explorer (with Windows Indexing enabled) to search the folder where I store these files and look for any files that might contain that link in order to prevent this from occurring. What I wanted was a way to access the File Explorer from the Excel environment. The following procedure performs this task very nicely.

Function WinExplore(TheFolder As String)

On Error Resume Next

Shell “Explorer.exe ” & TheFolder, vbNormalFocus

End Function

This function can be entered in a worksheet cell and when recalculated will open Explorer at the desired folder.

I hope that you find this useful.

 

#Excel: Exciting New Features – Using a Worksheet UDF to Modify Shapes on a Worksheet by David Hager

 

I recently published the following article about using a worksheet UDF to modify a shape on the worksheet.

https://dhexcel1.wordpress.com/2017/04/19/excel-modifying-shapes-from-an-udf-in-a-worksheet-cell-by-david-hager/

As a brief review, cells B2 and C2 use a data validation list to populate the desired shape and color. Cells G2 and G3 contain the ModifyShape and ModifyShapeColor UDFs.

I have added 2 new features to this powerful technique. The first feature is the ability to change the size of the shape. Entering a value in cells C7 and C8 on the ShapeTest worksheet will change the size of the shape. I have added data validation to those cells to restrict values to the 0.5-2.0 range.

The other feature is the ability to add text to the shape. By entering the text message in cell B13, the new text is added to the shape. The following figure show the layout for the worksheet.

Here is the code for the UDF with the added features.

Function ModifyShape(ShapeNumber, ShapeType, Optional Vis As Boolean = True)

Application.Volatile True

With ActiveSheet.Shapes(ShapeNumber)

.AutoShapeType = ShapeType

.Visible = Vis

.DrawingObject.Characters.Text = Worksheets(“ShapeTest”).Range(“b13”).Value

.Height = .Height * Worksheets(“ShapeTest”).Range(“c7”).Value

.Width = .Width * Worksheets(“ShapeTest”).Range(“c8”).Value

ModifyShape = “done”

End With

End Function

There are a few more features that I plan to add at a future date. Enjoy!

You can download the file here.

ModShape_NewFeatures

#Excel Exchange Rate UDF With Symbol Lookup by David Hager

A number of Excel UDFs used to be available which utilized the Yahoo Finance API. Then, Yahoo changed its protocol for that financial data source, which caused those procedures to stop working. However, Google still has its financial converters exposed. In particular, we are interested in obtaining the current exchange rate from one currency to another.

The main procedure for returning exchange rates from Google Finance came from this site.

http://www.codepal.co.uk/show/MS_Excel_Live_Currency_Converter

To use the UDF, under Tools, References in the VBE, scroll down the list and check:

Microsoft WinHttp Services, version 5.1

A table of currency codes and symbols was obtained from this web site.

http://investexcel.net/foreign-exchange-rate-function-in-excel/

The 2^nd argument of the UDF (DestCur) is used to lookup the currency symbol associated with the desired currency. The following lines of code illustrate how this is done. In the main module, the following variable is declared.

Global SymbolToLookup As String

This has to be a global variable since it is going to be used in an event procedure in a worksheet module.

The lookup table is on the CurrencySymbols worksheet. This code returns currency symbol to be applied.

SymbolToLookup = Application.WorksheetFunction.Index([CurrencySymbols!C2:C110], Application.WorksheetFunction.Match(DestCur, [CurrencySymbols!B2:B110], 0))

Note the syntax of the two ranges. This is a shorthand method of passing ranges to worksheet functions used in VBA.

Then, the SymbolToLookup variable is passed to the event procedure in the Convert worksheet module, which fires after the UDF is entered in a cell.

Private Sub Worksheet_Change(ByVal Target As Range)

Target.NumberFormat = “General” & SymbolToLookup

End Sub

The following figure shows the result using the UDF plus the event procedure.

The file can be downloaded here.

ExRate

#Excel Short and Sweet Tip #21 (Remove Unused Custom Formats) by David Hager

I am working on an application that generates a lot of custom number formats. But, they are created on the fly and do not need to exist permanently, so I searched for a way to delete the unused formats. Well, it turns out that the original developer of a procedure to do this (Leo Heuser) first published it in my EEE newsletter many years ago. It certainly works for what I need. However, if you use it, be aware that it will “flash” as the Format Cells dialog box is opened. This procedure is especially useful for users that receive an error message of “Too Many Custom Formats”.

Sub RemoveUnusedNumberFormats()

Dim strOldFormat As String

Dim strNewFormat As String

Dim aCell As Range

Dim sht As Worksheet

Dim strFormats() As String

Dim fFormatsUsed() As Boolean

Dim i As Integer

Application.ScreenUpdating = False

If ActiveWorkbook.Worksheets.Count = 0 Then

MsgBox “The active workbook doesn’t contain any worksheets.”, vbInformation

Exit Sub

End If

On Error GoTo Exit_Sub

Application.Cursor = xlWait

ReDim strFormats(1000)

ReDim fFormatsUsed(1000)

Set aCell = Range(“A1”)

aCell.Select

strOldFormat = aCell.NumberFormatLocal

aCell.NumberFormat = “General”

strFormats(0) = “General”

strNewFormat = aCell.NumberFormatLocal

i = 1

Do

‘ Dialog requires local format

SendKeys “{TAB 3}{DOWN}{ENTER}”

Application.Dialogs(xlDialogFormatNumber).Show strNewFormat

strFormats(i) = aCell.NumberFormat

strNewFormat = aCell.NumberFormatLocal

i = i + 1

Loop Until strFormats(i – 1) = strFormats(i – 2)

aCell.NumberFormatLocal = strOldFormat

ReDim Preserve strFormats(i – 2)

ReDim Preserve fFormatsUsed(i – 2)

For Each sht In ActiveWorkbook.Worksheets

For Each aCell In sht.UsedRange

For i = 0 To UBound(strFormats)

If aCell.NumberFormat = strFormats(i) Then

fFormatsUsed(i) = True

Exit For

End If

Next i

Next aCell

Next sht

‘ Suppress errors for built-in formats

On Error Resume Next

For i = 0 To UBound(strFormats)

If Not fFormatsUsed(i) Then

‘ DeleteNumberFormat requires international format

ActiveWorkbook.DeleteNumberFormat strFormats(i)

End If

Next i

Application.ScreenUpdating = True

Exit_Sub:

Set aCell = Nothing

Set sht = Nothing

Erase strFormats

Erase fFormatsUsed

Application.Cursor = xlDefault

End Sub

 

Continue watching here for the application I am making that needed this.

#Excel Short and Sweet Tip #20 (Create VBA Procedure List) by David Hager

If you use a lot of VBA procedures in your Excel work, you might find a need to list all of those procedures. In order to accomplish this, you can copy this procedure into a module in your workbook in the VBE. Under Tools, References, check the Microsoft Visual Basic for Applications Extensibility. When you run it, you will get a 2 column list in the active worksheet. The first column will contain the name of the module and the second column will have the procedure name.

 

Option Explicit

Sub GetTheList()

Dim N&, Count&, MyList(2000), List$

Dim Component As Variant

For Each Component In ActiveWorkbook. _

VBProject.VBComponents

With Component.CodeModule

Count = .CountOfDeclarationLines + 1

Do Until Count >= .CountOfLines

MyList(N) = .ProcOfLine(Count, _

vbext_pk_Proc)

Count = Count + .ProcCountLines _

(.ProcOfLine(Count, vbext_pk_Proc), _

vbext_pk_Proc)

ActiveSheet.Range(“a” & N).Value = .Name

ActiveSheet.Range(“b” & N).Value = MyList(N)

List = List & vbCr & MyList(N)

If Count < .CountOfLines Then N = N + 1

Loop

End With

N = N + 1

Next

End Sub

 

HTH!

Using Excel UDF to Translate a Phrase From One Language to Another by David Hager

After recently making an Excel Speller

https://dhexcel1.wordpress.com/2017/05/28/excel-short-and-sweet-tip-19-excel-can-spell-by-david-hager/

I decided to explore other applications that speak. The most logical choice was to make an Excel Translator. After searching the net, I found a good source for this.

The core VBA procedure came from Santosh

https://stackoverflow.com/users/2227085/santosh

in the following discussion.

https://stackoverflow.com/questions/19098260/translate-text-using-vba

There are a number of procedures that perform the same operation. However, none of them had a source of language codes to see, making them difficult to use without an external reference. Luckily, Microsoft has published a comprehensive list at:

https://msdn.microsoft.com/en-us/library/cc233982.aspx

I used Power Query to get the table from this site, load it in a worksheet, then unlink it from the query since it is a static table. I then modified the code to allow information to be looked up from the table to be used as part of the procedure. The complete code is here, with the underlined portions add by me.

Function Translate(str As String, lCode As String)

Dim IE As Object, i As Long

Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA

Set IE = CreateObject(“InternetExplorer.application”)

inputstring = “auto”

outputstring = lCode

text_to_convert = str

LangToLookup = Application.WorksheetFunction.Index([LCodes!b2:b150], Application.WorksheetFunction.Match(lCode, [LCodes!A2:A150], 0))

IE.Visible = False

IE.navigate “http://translate.google.com/#&#8221; & inputstring & “/” & outputstring & “/” & text_to_convert

Do Until IE.ReadyState = 4

DoEvents

Loop

Application.Wait (Now + TimeValue(“0:00:5”))

Do Until IE.ReadyState = 4

DoEvents

Loop

CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.document.getElementById(“result_box”).innerHTML, “</SPAN>”, “”), “<“)

 

For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)

result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) – InStr(CLEAN_DATA(j), “>”))

Next

IE.Quit

Translate = result_data

Application.Speech.Speak (“In ” & LangToLookup & “, ” & str & “means” & Translate)

End Function

The 2^nd argument of the TRANSLATE function was added, and the appropriate codes for that argument can be viewed on the LCodes worksheet. That variable was used with outputstring = lCode.

The following line of code returns the language name from the table.

LangToLookup = Application.WorksheetFunction.Index([LCodes!B2:B150], Application.WorksheetFunction.Match(lCode, [LCodes!A2:A150], 0))

The last line of code reads the information out loud.

Application.Speech.Speak (“In ” & LangToLookup & “, ” & str & “means” & Translate)

The result of using this function on the worksheet is shown below.

Be aware that some of the codes will not return a spoken phrase because of character differences (such as Hebrew).

You can download the file here.

xlTranslateFunction

Excel: Using Power Query to Return All Words From a List of Letters Including Wildcards by David Hager

I happened to run across a web site that returns all of the words by using a set number of letters.

http://wordfinder.yourdictionary.com/unscramble/

All credit for the working of the query demonstrated here goes to the aforementioned website.

So, I copied the URL of the query and found a way to use it in Power Query. I needed a way to add the string to the query, so I created an Excel table (named Letters) where the string would originate from.

Then, I was able to create M code that used the concatenated query and returned the output to the worksheet.

See:

let

QSource = Excel.CurrentWorkbook(){[Name=”Letters”]}[Content],

QText = QSource{0}[#”What Letters Do You Have?”],

Webstring = “http://wordfinder.yourdictionary.com/unscramble/”&QText,

Source = Web.Page(Web.Contents(Webstring)),

#”Removed Bottom Rows” = Table.RemoveLastN(Source,1),

#”Expanded Data” = Table.ExpandTableColumn(#”Removed Bottom Rows”, “Data”, {“Word”, “Scrabble® Points”}, {“Word”, “Scrabble® Points”}),

#”Removed Columns” = Table.RemoveColumns(#”Expanded Data”,{“Caption”, “Source”, “ClassName”, “Id”}),

#”Changed Type” = Table.TransformColumnTypes(#”Removed Columns”,{{“Word”, type text}, {“Scrabble® Points”, Int64.Type}})

in

#”Changed Type”

Here is an example of what the worksheet looks like after running it.

I was having trouble refreshing the query, so I asked Excel MVP and Power Query guru Ken Puls http://www.excelguru.ca/ for some help. This is the event procedure he came up with to refresh the query from the ListObjects(“Letters”) table.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Not Intersect(Target, ListObjects(“Letters”).DataBodyRange) Is Nothing Then

ListObjects(“IsWord”).QueryTable.Refresh BackgroundQuery:=False

End If

End Sub

Shortly after making this Power Query Scrabble Words app, I discovered a website where an Excel-based Scrabble game was available.

http://www.dustinormond.com/blog/vba-scrabble/

I started playing this game and connected the letters from that game to the Scrabble Words app with external links. In order to control the process, I used a formula to concatenate the linked letters (in I2:Q2) to make the string needed for the query.

=IF(I3=””,I2,I3)&IF(J3=””,J2,J3)&IF(K3=””,K2,K3)&IF(L3=””,L2,L3)&IF(M3=””,M2,M3)&IF(N3=””,N2,N3)&IF(O3=””,O2,O3)&IF(P3=””,P2,P3)&IF(Q3=””,Q2,Q3)

In the model I am sharing with you, there are no external links for obvious reasons. But, if there were blank tiles, then I could replace the blank with a letter (i.e. – L2 is blank and the letter in L3 would take its place. The only drawback is that the formula in G2 has to be recalculated for the Power Query query to refresh. This can be done by clicking in G2 and hitting Enter.

But, as I was starting work on this article, I went back to the source web site and discovered something I had overlooked. Wildcards (2 of them) can be used in the query! On that site, they use question marks as wildcard characters, but the query I made will only work with an underscore. So, in the following figure, I demonstrate how this is done.

Whether you use this for playing (cheating at) Scrabble or just to use the generated words in some other way, I think that you will find this technique to be very useful.

Unfortunately, I do not have permission from the website for file download, but I still hope that you find this information useful.

 

#Excel Short and Sweet Tip #19 (Invaluable Excel Speller) by David Hager

Do you know about those kids toys that spells out the name of an object and then says the word? Well, you can do the same thing in Excel. This article is about the use of Speech.Speak in VBA, and this process provides a good demonstration of its use. Place this event procedure in a Worksheet module.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

textInCell = Target.Value

If textInCell = “” Then Exit Sub

For n = 1 To Len(textInCell)

If Asc(Mid(textInCell, n, 1)) > 64 And Asc(Mid(textInCell, n, 1)) < 91 Then

Application.Speech.Speak “Capital ” & Mid(textInCell, n, 1)

Else

Application.Speech.Speak Mid(textInCell, n, 1)

End If

Next

Application.Speech.Speak (“spells ” & textInCell)

End Sub

Then, select a cell on the worksheet and if it contains a word it will spell the word and then say it. In the example file, A1 contains the word “Elephant”. If that cell is selected, it will be spelled out starting with “capital E” followed by the rest of the letters and then says “spells Elephant”.

You can download the file here. It also contains a greeting upon opening the workbook.

Welcome

#Excel UDF Using Google API to Return the Elevation of an Address by David Hager

There has been a lot of interest in using the Google API in Excel VBA for geocoding.

This article demonstrated a method of returning latitude and longitude coordinates from an address

http://analystcave.com/excel-get-geolocation-coordinates-of-an-address/

and this article showed how to return an elevation from latitude and longitude coordinates.

http://oco-carbon.com/coding/altitude-in-excel-google-elevation-api/

So, I decided to combine the techniques from both articles to create an UDF that would use an address to give the elevation of that location. The first line of code illustrates the function arguments.

Function ElevationFromAddress(address As String, Optional ToFeet As Boolean) As Double

An address string is the 1^st argument and there is an optional 2^nd boolean argument for coverting meters to feet. Please feel free to download the example file containing the complete code for the UDF

The Google API algorithm can recognize locations with limited or detailed address information. The first two records in the table are for locations at a considerable altitude. The next record is for a Baptist seminary in Fort Worth, Tx. The last records are both for The White House in Washington, D.C. Note that the values are different – the first record must be for the front gate while the generic address refers to the actual building. As shown in the figure, the formulas in column B use the 2^nd optional argument to return the elevation in feet.

This function procedure requires a reference to Microsoft XML, v6.0, selected in the VBE under Tools, References, as shown here.

The file can be downloaded here.

ElevationFromAddress

Copy #Excel Chart as a Enhanced Metafile Picture by David Hager

I am sharing here yet another great Excel technique from Rob van Gelder. This procedure allows you to click a chart in any open workbook and run the macro to convert the chart to a .emf file at the location of your choice. See:

http://dailydoseofexcel.com/archives/2012/05/05/copy-chart-as-a-picture/#comments

The code from that article is shown here.

Declare Function OpenClipboard Lib “user32” (ByVal hwnd As Long) As Long

Declare Function CloseClipboard Lib “user32” () As Long

Declare Function GetClipboardData Lib “user32” (ByVal wFormat As Long) As Long

Declare Function EmptyClipboard Lib “user32” () As Long

Declare Function CopyEnhMetaFileA Lib “gdi32” (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long

Declare Function DeleteEnhMetaFile Lib “gdi32” (ByVal hemf As Long) As Long

Const CF_ENHMETAFILE As Long = 14

Const cInitialFilename = “Picture1.emf”

Const cFileFilter = “Enhanced Windows Metafile (*.emf), *.emf”

 

Public Sub SaveAsEMF()

Dim var As Variant, lng As Long

 

var = Application.GetSaveAsFilename(cInitialFilename, cFileFilter)

If VarType(var) <> vbBoolean Then

On Error Resume Next

Selection.Copy

 

OpenClipboard 0

lng = GetClipboardData(CF_ENHMETAFILE)

lng = CopyEnhMetaFileA(lng, var)

EmptyClipboard

CloseClipboard

DeleteEnhMetaFile lng

On Error GoTo 0

End If

End Sub

You can download the file containing this procedure here.

CopyChartAsPicture

Important note: This solution will run correctly only on 32-bit systems – not 64-bit. If you really need it to work on 64-bit, you can try to modify the code based on the information located at:

http://www.jkp-ads.com/articles/apideclarations.asp

#Excel: Origin of Sparklines – LineChart VBA User-Defined Function by David Hager

A number of Excel features added to the product by Microsoft over the years were originally made by Excel developers. The addition of sparklines added a whole new way to visualize data. Before they were an Excel feature, sparklines were popularized by Edward Tufte. See:

https://www.edwardtufte.com/bboard/q-and-a-fetch-msg?msg_id=000AI

The inspiration for the implementation of sparklines in Excel actually came from Excel developer Rob van Gelder. In this article

http://dailydoseofexcel.com/archives/2006/02/05/in-cell-charting/

he shares the VBA code for the LineChart user-defined function, which places a chart in the cell where the function is called from. You can view the use of this UDF and the VBA code in this example file.

 UDFLineChart

If you are not familiar with Excel’s built-in sparkline feature, you can read the following Microsoft article.

https://support.office.com/en-us/article/Use-sparklines-to-show-data-trends-1474E169-008C-4783-926B-5C60E620F5CA

 

#Excel: Creating a Environmental Variables Table with the VBA ENVIRON Function UDF by David Hager

Is it useful to obtain information about the various aspects of your PC operating system. This can easily be done with the VBA ENVIRON function. Since it is a VBA function, it cannot be used directly in a worksheet cell. The following UDF encapsulates the ENVIRON function, and this function can be used on the worksheet.

Function Env(Lposition As Variant)

Env = Environ(LPosition)

End Function

It is important to note that the variable Lposition is declared as a Variant so that both numeric and built-in Excel strings can be used by this UDF. I could not find a list of the strings on the net, but in this example I will show you how to make a list. The values listed below are for my computer.

A1: =Env(ROW()) returns ALLUSERSPROFILE=C:\ProgramData

B1: =LEFT(A1,FIND(“=”,A1)-1) returns ALLUSERSPROFILE

C1: =Env(B1) returns C:\ProgramData

Note that in B1 is the built-in string argument used by C1.

You can download the file here.

Envir

When you do, fill A1:C1 down to row 40 on the worksheet to make the environmental variable table for your computer. Column B will contain the built-in strings. I hope that you find this useful.

#Excel Short and Sweep Tip #10 (Add Custom AutoCorrect with UDF) by David Hager

I was reading articles at exceloffthegrid.com and I came across this technique to add an autocorrect replacement in Excel.

https://exceloffthegrid.com/autocorrect-hack-to-speed-up-data-entry/

I thought that it would be useful to make a way to automate this process. So, I created the following VBA function procedure (put in a general module in VBE).

Function AutoCorrectAdd(ReplaceWhat As String, ReplaceWith As String)

Application.AutoCorrect.AddReplacement What:=ReplaceWhat,Replacement:=ReplaceWith

End Function

So, if cell A2 contained RobC and B2 contained https://powerpivotpro.com/, then the formula

= AutoCorrectAdd(A2,B2), run in a worksheet UDF

would add that autocorrect replacement the built-in AutoCorrect list. If you then type RobC, it would be replaced by https://powerpivotpro.com/.

You could also use this function in a Sub procedure. Say that you had an Excel list of nicknames and their corresponding e-mail addresses. You could create a Sub that operated on each row of the two column list with the AutoCorrectAdd function to convert the list to autocorrect replacements (not shown, a challenge to the reader 😊).

Hope that you find this useful.

Excel Short & Sweet Tip #9 (Get IP Address) by David Hager

Here is a way to get the IP address of your computer. This was originally reported at

http://stackoverflow.com/questions/828496/how-to-retrieve-this-computers-ip-address

Make sure that you have the required reference (WMI Scripting) selected under Tools, References in the VBE as shown in the figure below.

Copy/paste the following code to a general module in the VBE and then type =GetIPAddress() into a worksheet cell (or, use it in a VBA procedure).

Function GetIPAddress()

Const strComputer As String = “.”   ‘ Computer name. Dot means local computer

Dim objWMIService, IPConfigSet, IPConfig, IPAddress, i

Dim strIPAddress As String

 

‘ Connect to the WMI service

Set objWMIService = GetObject(“winmgmts:” _

& “{impersonationLevel=impersonate}!\\” & strComputer & “\root\cimv2”)

 

‘ Get all TCP/IP-enabled network adapters

Set IPConfigSet = objWMIService.ExecQuery _

(“Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE”)

 

‘ Get all IP addresses associated with these adapters

For Each IPConfig In IPConfigSet

IPAddress = IPConfig.IPAddress

If Not IsNull(IPAddress) Then

strIPAddress = strIPAddress & Join(IPAddress, “, “)

End If

Next

 

GetIPAddress = strIPAddress

End Function

HTH!

#Excel: Generating a Random Sampling From a List Using VBA and the TEXTJOIN Function by David Hager

You might have a need to generate a random sampling of items from an Excel list. The technique presented here accomplishes this without any helper columns. The PickRandomFromList VBA function shown below returns a random array of items from a worksheet list, the size determined by the 2^nd argument of the function.

Function PickRandomFromList(rList As Range, sArray As Integer) As Variant

Dim N As Long

Dim Arr() As Variant

Dim lArr() As Variant

Dim Temp As Variant

Dim J As Long

Application.Volatile False

Arr = rList.Value

Randomize

ReDim lArr(LBound(Arr) To sArray

For N = 1 To sArray

J = CLng(((UBound(Arr) – N) * Rnd) + N)

Temp = Arr(N, 1)

lArr(N) = Arr(J, 1)

Arr(J, 1) = Temp

Next N

PickRandomFromList = lArr

End Function

It is important to note that this UDF does not recalculate with every change in the worksheet by using the line of code Application.Volatile False. It will only recalculate if a change is made in the cell containing the formula or in the specified worksheet range. The conversion of the array to a delimited list is done through the use of the TEXTJOIN function.

=TEXTJOIN(“,”,,PickRandomFromList(A2:A22,5))

This technique may be particularly useful for the selection of random committees from an employee list. I hope that this will give you some ideas about situations requiring random sampling.

You can download the workbook here.

PickList

Excel Short & Sweet Tip #8 (VBA Function to Return Zodiac Sign) by David Hager

Here is a VBA function procedure that will allow you to return the sign of the zodiac for a given data.

Copy/paste it into a general module in the VBE.

Public Function ZodiacSign(BirthDate As Date) As String

Dim iDayofYear As Integer

iDayofYear = DateDiff(“d”, CDate(“1/1/” & Year(BirthDate)), BirthDate) + 1

If Year(BirthDate) Mod 4 = 0 And iDayofYear > 59 Then

iDayofYear = iDayofYear – 1

End If

If iDayofYear < 20 Then

ZodiacSign = “Capricorn”

ElseIf iDayofYear < 50 Then

ZodiacSign = “Aquarius”

ElseIf iDayofYear < 81 Then

ZodiacSign = “Pisces”

ElseIf iDayofYear < 111 Then

ZodiacSign = “Aries”

ElseIf iDayofYear < 142 Then

ZodiacSign = “Taurus”

ElseIf iDayofYear < 173 Then

ZodiacSign = “Gemini”

ElseIf iDayofYear < 205 Then

ZodiacSign = “Cancer”

ElseIf iDayofYear < 236 Then

ZodiacSign = “Leo”

ElseIf iDayofYear < 267 Then

ZodiacSign = “Virgo”

ElseIf iDayofYear < 297 Then

ZodiacSign = “Libra”

ElseIf iDayofYear < 327 Then

ZodiacSign = “Scorpio”

ElseIf iDayofYear < 357 Then

ZodiacSign = “Sagittarius”

Else

ZodiacSign = “Capricorn”

End If

End Function

When entered in a worksheet cell (=ZodiacSign(A1)), where A1 contains the birthdate in question, the correct sign of the zodiac will be returned. Note that this part of the function code

If Year(BirthDate) Mod 4 = 0 And iDayofYear > 59 Then

iDayofYear = iDayofYear – 1

End If

adjusts the day of year if the year of birth is a leap year.

#Excel Worksheet UDF that Adds a Comment to Any Cell by David Hager

There was a lot of interest in my post on modifying a shape with a worksheet UDF.

https://dhexcel1.wordpress.com/2017/04/19/excel-modifying-shapes-from-an-udf-in-a-worksheet-cell-by-david-hager/

The original idea was posted in 2007. I seem to remember, though, that the use of a UDF to modify cells occurred before that time. The initial discovery was that a UDF could add a cell comment to ANY cell. I can’t find the original reference, but this technique was last documented at:

http://www.listendata.com/2013/04/excel-udf-dependent-cell-comment.html

I have modified the the UDF shown in that article to add a timestamp feature.

Function AddComment(rng As Range, str As String) As String

If Not rng.Comment Is Nothing Then rng.Comment.Delete

TimeStamp = Date & ” ” & Time

If Len(str) Then rng.AddComment.Text str & ” ” & TimeStamp

rng.Comment.Visible = True

End Function

In the example workbook, I entered the AddComment function in cell D6, but the range argument can point to any cell. In fact “range formulas” can also be used.

The INDEX, OFFSET and INDIRECT Excel functions all return ranges, so any formulas built with these functions can be used in a UDF where a range argument is required. The following example uses the INDEX function.

=AddComment(INDEX(NumRange,MATCH(MAX(NumRange),NumRange,0)),”MAX value in NumRange”)

where NumRange is defined as =OFFSET(A$1,,,COUNTA($A:$A),) ‘auto-expanding range

In this example, the formula INDEX(NumRange,MATCH(MAX(NumRange),NumRange,0)) returns the range of the cell containing the max value of NumRange, and as such it can be used in the first argument of the UDF. So, as numbers are added to column A as shown in the figure

the function will add a timestamped comment to any cell in that range that is the max value.

Obviously, there are numerous and more complex examples that can be built using this technique. I hope that you will find this useful in your projects.

The example file can be downloaded here.

AddComment

#Excel: Using Conditional Formatting to Highlight 3D Formulas with Defined Names by David Hager

There was a comment on LinkedIn about my post about using CF to highlight 3D formulas

“Since I never use a direct reference (or, come to that, enter a formula without naming the range to which it applies) any 3D reference I might use would pass under the radar. Unless, of course, you have an array UDF which will parse the formula to yield a set of references; in which case can I put in an order?”

Initially, I replied that it was not possible. But, the challenge was irresistable. I started working on the problem and, after a number of dead-ends, I was able to come up with a solution. It required a VBA function to return an array of defined names.

Function DefinedNameArray() As Variant

Application.Volatile

Dim Arr As Variant

nCount = ActiveWorkbook.Names.Count

ReDim Arr(1 To nCount)

For N = 1 To nCount

cPos = InStr(1, ActiveWorkbook.Names(N).RefersTo, “:”)

ePos = InStr(1, ActiveWorkbook.Names(N).RefersTo, “!”)

If cPos < ePos Then

Arr(N) = ActiveWorkbook.Names(N).Name

Else

Arr(N) = “”

End If

Next

 

DefinedNameArray = Arr

End Function

What the VBA function does is return an array of defined names, but only places the items meeting the correct criteria for a 3D formula in the final array (which is the same concept using in the initial article).

https://dhexcel1.wordpress.com/2017/04/24/excel-using-conditional-formatting-to-highlight-cells-containing-native-3d-formulas-by-david-hager/

In this case, the InStr function was used to locate the positions of the first colon and exclamation point in the RefersTo string and the values are compared. If cPos<ePos, then the name is added to the array and a null string added otherwise. This array is used in the following formula to find if a 3D defined name is part of the string returned by the FORMULATEXT function. It was defined for use as a CF formatting formula, as shown below (F5 was the active cell when defined).

Is3DDefinedName=MATCH(TRUE,IFERROR(FIND(IFERROR(DefinedNameArray(),””),FORMULATEXT(F5))>1,FALSE),0)

Both F5 and F7 contain formulas using 3D defined ranges.

Peter, thanks for the challenge!

You can download the example file here.

CFDefinedNames

#Excel VBA: Create a Table of File Locations and URLs for Your Favorites by David Hager

This is one of my personal Excel applications that I have used over the years to collect information on my Internet Favorites. When you run the CreateURLListFromFiles procedure, it creates a list of URLs and favorites file location. You browse to your Favorites folder and select to generate the table. Column B contains the URLs that can be converted to hyperlinks by selecting them and running the Convert To Hyperlinks procedure. You can use this on multiple folders where your favorites are stored and the results will be appended. Enjoy!

You can download the file here.

MyURLCollector

Mine3D for #Excel: An Excel-based Game by David Hager

I would like to share with you an Excel game that I made back in the day. It is called Mine 3D, and it works like the popular minesweeper game, except that the playing board is “3 dimensional”. The worksheets are protected, but with no password. There is a interesting combination of formulas and programming used in the making of this game. So, feel free to explore how it works. Enjoy!

You can download the Excel game here.

Mine3D 

 

 

Using #Excel VBA to Create a Filter Criteria User Defined Function by David Hager

Some of the very best Excel work in the early years was done by Stephen Bullen. His legacy Excel site still exists, but it has not been updated in many years.

http://www.oaltd.co.uk/Excel/Default.htm

One of Stephen’s creations was a “simple” VBA function to return the applied criteria of a filtered list to a worksheet cell (shown below).

 

Function FilterCriteria(Rng As Range) As String

‘By Stephen Bullen

Dim Filter As String

Filter = “”

On Error GoTo Finish

With Rng.Parent.AutoFilter

If Intersect(Rng, .Range) Is Nothing Then GoTo Finish

With .Filters(Rng.Column – .Range.Column + 1)

If Not .On Then GoTo Finish

Filter = .Criteria1

Select Case .Operator

Case xlAnd

Filter = Filter & ” AND ” & .Criteria2

Case xlOr

Filter = Filter & ” OR ” & .Criteria2

End Select

End With

End With

Finish:

FilterCriteria = Filter

End Function

The use of this function is illustrated in the following figure. The formulas are in row 1.

Here is another view with criteria applied to other columns.

It also shows a limitation that this function had. Since the .Criteria1 and Criteria2 properties are strings, when criteria is set for a date column, the string contains Excel’s “date number”, not the date formatted number displayed in the cells. In order to workaround this limitation, I amended the function as shown below.

Function FilterCriteriaEnh(Rng As Range) As String ‘Enhanced to handle date filters

‘By Stephen Bullen and David Hager

Dim Filter As String

Dim Criteria2 As String

Filter = “”

sFormat = Application.Index(Rng, 2).NumberFormat

‘On Error GoTo Finish

With Rng.Parent.AutoFilter

If Intersect(Rng, .Range) Is Nothing Then GoTo Finish

With .Filters(Rng.Column – .Range.Column + 1)

If Not .On Then GoTo Finish

Filter = .Criteria1

If sFormat = “m/d/yyyy” Then

Filter = Left(Filter, InStr(Filter, OnlyDigits(Filter)) – 1) & _

Format(OnlyDigits(Filter), sFormat)

On Error GoTo Finish

Criteria2 = Left(.Criteria2, InStr(.Criteria2, OnlyDigits(.Criteria2)) – 1) & _

Format(OnlyDigits(.Criteria2), sFormat)

End If

Select Case .Operator

Case xlAnd

Filter = Filter & ” AND ” & Criteria2

Case xlOr

Filter = Filter & ” OR ” & Criteria2

End Select

End With

End With

Finish:

FilterCriteriaEnh = Filter

End Function

 

Function OnlyDigits(s As String) As String

With CreateObject(“vbscript.regexp”)

.Pattern = “\D”

.Global = True

OnlyDigits = .Replace(s, “”)

End With

End Function

 

First, I needed to capture the format from the column is question to see if it was date formatted.

sFormat = Application.Index(Rng, 2).NumberFormat

If sFormat = “m/d/yyyy” Then

Filter = Left(Filter, InStr(Filter, OnlyDigits(Filter)) – 1) & _

Format(OnlyDigits(Filter), sFormat)

The change in the string for the Filter variable is made by the formula shown above. The OnlyDigits function used in the formula construction is not original, but I do not know the source. It puts the string back together with the date replacing the date system number.

I did the same thing for Criteria2, but it will not exist if a second criteria is not selected in the filter, so I had to add error handling for that scenario.

On Error GoTo Finish

Criteria2 = Left(.Criteria2, InStr(.Criteria2, OnlyDigits(.Criteria2)) – 1) & _

Format(OnlyDigits(.Criteria2), sFormat)

A final filter list example using this enhanced function is shown below.

You can download the file for this here.

FilterCriteria

Archive of Excel Experts E-Letter (by David Hager)

Previously hosted on John Walkenbach’s web site, the material included here is unabridged. Therefore, many of the links are no longer good. Also, some of this information is dated and obsolete. Nonetheless, I am posting it here because it does contain a number of VBA procedures and Excel formulas that are still of use today, and to preserve a record of what was new and exciting in the Excel world many years ago.

Here is the link.

eee-1-20

xlCube: An Excel game

xlcube

I invented this Excel game back in the 1990’s and this is the 4th iteration, made in 1999.

It has a lot of neat techniques in it, feel free to examine it. It requires a lot of practice to play this game effectively. It is like a 3D version of Battleship. I did not erase the scores from the previous times this game was played, but you can.

Enjoy!

Power BI Help for Excel

August 31, 2015

by David Hager

Power Pivot and Power Query add-ins for Excel have revolutionized the way business intelligence can be done. Further, Microsoft has put a lot of effort into providing extensive online documentation for both of these BI tools. However, there is no direct connection between the add-ins and the online help files. There is a help icon on the Power Query ribbon but in my experience the link is always broken. Wouldn’t it be great if you could access Microsoft’s online documentation for Power Pivot and Power Query directly from within Excel?

The Solution!

Available here is the Power BI Help for Excel file. When you open it in Excel, the custom ribbon displays two buttons: one for DAX functions help and one for Power Query functions help. An userform is displayed which allows you to select the desired function category from a list. This action populates the functions in that category in another list. When one of the functions is selected, the desired Microsoft help documentation for that function is shown. Then, you can either read or print the web page. Please note that the help information available to be viewed is current to the creation date of this file. Any deletions/additions by Microsoft of these functions will not be automatically updated for this file. Further, any changes to the URLs to this online information by Microsoft will break the application. I hope that this will be beneficial to you in your Power BI learning curve.

IMPORTANT NOTE: DO NOT TRY TO OPEN FROM THE LINK BELOW. Instead, save it to your computer. Then, in Windows Explorer, change the file extension from .xlsx to .xls. After this action, you can open it normally in Excel.

Power BI Help for Excel