Is this number prime?

In one of my (many) previous lives, I wanted to be a mathematician.

Even after I realized that being a mathematician would preclude a lifestyle that I wanted to become accustomed to, I still retained an active interest in mathematics. One of the areas that I found fascinating involved prime numbers.

I’ve seen many UDFs in the newsgroups, mostly provided by Excel MVPs, to determine if a number is prime. However, the following is the shortest UDF that I’ve been able to come up with:

Function IsPrime(Num As Single) As Boolean
    Dim i As Long
    If Num < 2 Or (Num <> 2 And Num Mod 2 = 0) _
     Or Num <> Int(Num) Then Exit Function
    For i = 3 To Sqr(Num) Step 2
        If Num Mod i = 0 Then Exit Function
    Next
    IsPrime = True
End Function

The reason for declaring the input number Num as a Single is that if it’s declared as an Integer or a Long, an input value of, say, 3.2 will be coerced to 3 and be evaluated as a prime number. Clearly, this is not the desired result. There is probably a better way of handling this, but I can’t figure it out.

I’d be interested in some comments as to whether this code can be shortened or made more elegant.

Divisonal Double Elimination Brackets

My eight team golf league wanted to do tournament-style scheduling for the final six weeks of the season. We wanted double-elimination and it had to fit in six weeks. We went with a two-division, double-elimination bracket with a single-elimination championship match. This is what the Big XII uses for its baseball tournament, albeit slightly modified.

One difference that we had to account for was that everyone needed to play every week. Everyone paid, so it’s just silly to actually sit out when you have a bye or are eliminated. We structured it thusly: Eliminated teams and teams with a bye for that week would go into a pool and would play another pool team to whom they were randomly assigned. First and second place (for the season) would be determined by the brackets and third through eighth place would be determined using the same points system used throughout the season. This way, we could have all the excitement of elimination brackets, yet eliminated and bye-week teams would still be motivated to play well (to keep accumulating points to get into third or fourth place).

The spreadsheet uses many of the same techniques as the March Madness spreadsheet.

spreadsheet showing double elimination bracket

Download DoubleElimDiv.zip

Conditional Formatting Validation Macro

In Conditional Data Validation, I described how to set up conditional formatting to alert you when your list validation was no longer valid. I also noticed that this is covered in Professional Excel Development (and much better, I might add) so if you haven’t ordered your copy yet, I suggest you do.

I recently had cause to use this technique, but my lists were all over the place. I couldn’t set up the CF on one cell, then copy it to the others because the relationship between the cells wasn’t the same as the relationship between the lists. I created this macro to loop through all the cells on the sheet and if there’s list validation, it adds conditional formatting.

Sub FormatValidation()
     
    Dim rCell As Range
    Dim lValType As Long
    Dim CllFc As FormatCondition
   
    For Each rCell In Sheet1.UsedRange.Cells
   
        ‘set valtype to a number that is not valid for the enumeration
       lValType = -1
       
        ‘Attempt to read the cell’s validation type
       On Error Resume Next
            lValType = rCell.Validation.Type
        On Error GoTo 0
       
        ‘If the cell had validation and the type was ‘list’
       If lValType = xlValidateList Then
           
            ‘Delete existing conditional formatting
           On Error Resume Next
                rCell.FormatConditions.Delete
            On Error GoTo 0
           
            ‘Create format condition with a formula that looks like:
           ‘=ISERROR(MATCH(cell, validationlistrange, FALSE))
           With rCell.Validation
                Set CllFc = rCell.FormatConditions.Add(Type:=xlExpression, _
                    Formula1:=“=ISERROR(MATCH(“ & rCell.Address & “,” & _
                        Right(.Formula1, Len(.Formula1) – 1) & “,FALSE))”)
            End With
           
            CllFc.Interior.Color = vbRed
        End If
    Next rCell
           
End Sub

Inserting Events Template

When I want to write event code in a Workbook, I Alt-F11 to open the VBE, Cntl-R to open the Project Explorer, arrow to the class module in which the code will go, and… Then, as far as I can tell, I have to use my mouse and the dropdowns at the top of the module to insert the Sub and End Sub lines.

dropdowns at the top of the sheet module showing Worksheet and Change

I could just type them in, but I would to get the arguments just right or the VBE wouldn’t like it. It would be nice if the Insert > Procedure menu item had a provision for event code.

Insert procedure dialog box

The best solution I could muster is to create text files that contain the code I want. I have two text files in my Office folder (Program FilesMicrosoft Office 2000Office is the default folder for Insert > File) called SheetEvents.txt and WorkbookEvents.txt.

Insert file menu item

SheetEvents contains the Worksheet_Change and Workbook_SelectionChange events. WorkbookEvents contains Open, BeforeClose and BeforeSave. Those are the events I use most often. I thought about making a separate file for each event, but I decided to just put the most common ones in a file and delete anything I don’t need. Creating the text files was a simple copy and paste operation into Notepad after I used the dropdowns to get the events I wanted.

Create Pivottable-reports with VB.NET

I thought it would be of general interest to see how we can create reports based on Pivottable(s) by automating Excel from VB.NET 2003.

Depending on what the purpose is with a report we can control what the end-users can do via the creation of the SQL-query and how we setup of the Pivotable(s).

In the example early binding is in use and the following namespaces must be imported to the project:

Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices

Maincode:

  Const stCon As String = _
 “ODBC;DSN=MS Access Database;” & _
 “DBQ=C:Northwind.mdb;DefaultDir=C:;” & _
 “DriverId=25;FIL=MS Access;” & _
 “MaxBufferSize=2048;PageTimeout=5;”
 
 Const stSQL As String = _
 “SELECT ShipCountry, “ & _
 “COUNT(Freight) AS [# Of Shipments], “ & _
 “SUM(Freight) AS [Total Freight] “ & _
 “FROM Orders “ & _
 “GROUP BY ShipCountry;”
 
Dim xlApp As Excel.Application
 
Try
     ‘Grab a running instance of Excel.
     xlApp = Marshal.GetActiveObject(“Excel.Application”)
Catch ex As COMException
      ‘If no instance exist then create a new one.
     xlApp = New Excel.Application
End Try
 
Dim xlWBook As Excel.Workbook = xlApp.Workbooks.Add(Excel.XlWBATemplate.xlWBATWorksheet)
Dim xlWSheet As Excel.Worksheet = CType(xlWBook.Worksheets(1), Excel.Worksheet)
Dim xlRange As Excel.Range = CType(xlWSheet, Excel.Worksheet).Range(“B2”)
 
‘Create the Pivotcache.
Dim ptCache As Excel.PivotCache = xlWBook.PivotCaches.Add( _
SourceType:=Excel.XlPivotTableSourceType.xlExternal)
 
‘Setup the Pivotcache.
With ptCache
.Connection = stCon
.CommandText = stSQL
.CommandType = Excel.XlCmdType.xlCmdSql
End With
 
‘Create the Pivottable.
Dim ptTable As Excel.PivotTable = _
xlWSheet.PivotTables.Add( _
PivotCache:=ptCache, _
TableDestination:=xlRange, _
TableName:=“PT_Report”)
 
‘Setup the Pivottable.
With ptTable
.ManualUpdate = True
.PivotFields(“ShipCountry”).Orientation = Excel.XlPivotFieldOrientation.xlRowField
.PivotFields(“# Of Shipments”).Orientation = Excel.XlPivotFieldOrientation.xlDataField
.PivotFields(“Total Freight”).Orientation = Excel.XlPivotFieldOrientation.xlDataField
.Format(Excel.XlPivotFormatType.xlReport2)
.ManualUpdate = False
End With
 
 xlWBook.SaveAs(“c:Report.xls”)
 
‘Switch to Excel.
With xlApp
.Visible = True
.UserControl = True
End With
 
‘Tell the Garbage Collector that these objects are ready to be destroyed.
ptTable = Nothing
ptCache = Nothing
xlWSheet = Nothing
xlWBook = Nothing
xlApp = Nothing

Personally I use more and more VB.NET to create “reporttools” instead of VB 6.0 although I still find it hard to switch between VBA/VB and VB.NET.

Kind regards,
Dennis

Playing WAV Files

Frank asks:

Dick, would it be a lot of trouble to make the American National Anthem play when displaying the flag?

First, go to the Embassy of the United States of America in Stockholm, Sweden’s website and download their wav file of the national anthem.

Next, go to The Spreadsheet Page and borrow John’s code for playing a wav file.

With a little modification, the code looks like this:

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
 
Sub PlayWAV(ByVal sWav As String)
    Call PlaySound(sWav, 0&, SND_ASYNC Or SND_FILENAME)
End Sub

and add this to the fly the flag code

    sWav = ThisWorkbook.Path & “anthem.wav”
    PlayWAV sWav

Don’t forget to declare sWav in your code. Or you can just download the file

Download FlyFlag.zip

A Touch of Grey

Yesterday was my birthday. No complicated birthday formulas this year, just a binary cake.

Birthday cake with eight candles with the third and sixth lit

I would apologize for the poor MS Paint job on that clip art, but if you’ve been reading this blog for any length of time, you know I stink at graphics.

I started browsing around for birthday cake clipart in Excel and came upon the Special Occasions section. It has balloons on the graphic, which is promising. I get in there (Insert > Picture > ClipArt) and see this:

insert clipart dialog box

What is happening in the second picture? Is that a guy bowling and using buildings for pins? Which special occasion does that represent, the rapture?

In picture 6, there’s a wizard looking through a telescope. I can only assumes you would use that when something good happens in your Dungeons and Dragons game. I may be nerdy enough to have a binary birthday cake, but I’m not so nerdy that I know enough D&D lingo to even make a decent joke.

Picture 7 depicts the “special occasion” when Egyptian slaves finished the pyramids. I don’t recall them wearing business suits, but to be fair, I wasn’t there.