Did you like the first slide in this challenge? We hope so. The first slide turned out to where Binder Clippy has been hiding throughout OfficePalooza. We wanted to give Binder Clippy a little bigger role throughout this competition, but, well, there were some contract issues…. As a result, Binder Clippy got demoted from emcee to featured character on a PowerPoint slide.

Note. If you don’t know what we’re talking about, don’t worry about it. We were going to add a link to the real story of Binder Clippy, but someone snuck in and rewrote the tale before we got to it. To be honest, we’re now too embarrassed by the final outcome to show it to you. But trust us, it was a great story.

Really.

But enough about our poor, ill-fated mascot; it’s time to talk about this challenge. This was a tough one. As you probably found out, it’s one thing to start up a slide show from a macro, but it’s a whole ‘nother thing to show the slides in any order other than the order they appear in PowerPoint. But we managed, by doing this:

Public Sub SkipSlides()

 

Dim i As Integer

Dim j As Integer

Dim o As Integer

Dim e As Integer

 

Dim temp1 As Integer

Dim temp2 As Integer

 

Dim strShowName As String

Dim arrOdd() As Integer

Dim arrEven() As Integer

Dim slideCount As Integer

Dim arrAll() As Integer

Dim customShow As NamedSlideShow

 

'Find out how many slides are in the slideshow.

slideCount = ActivePresentation.Slides.Count

 

'Initialize variables

i = 1

strShowName = "Alternate Slides"

temp1 = slideCount / 2 'Divide the slide count by 2

temp2 = slideCount Mod 2 'If there is an odd number of slides, need to account for the odd one

 

'Number of odd-numbered slides (slides 1, 3, etc.) is temp1 plus temp2;

' number of even-numbered slides (slides 2, 4, etc.) is half of the total.

o = temp1 + temp2

e = temp1

 

ReDim arrOdd(o)

ReDim arrEven(e)

ReDim arrAll(slideCount)

 

'Create an array containing the slide ID of each odd-numbered slide.

j = 1

While (i <= o)

    arrOdd(i) = ActivePresentation.Slides(j).SlideID

    j = j + 2

    i = i + 1

Wend

 

'Create an array containing the slide ID of each even-numbered slide.

j = 2

i = 1

While (i <= e)

    arrEven(i) = ActivePresentation.Slides(j).SlideID

    j = j + 2

    i = i + 1

Wend

 

'Add the odd-numbered slides to a single array.

i = 1

j = 1

While (i <= o)

    arrAll(i) = arrOdd(i)

    i = i + 1

Wend

 

'Add the even-numbered slides to the array following the odd-numbered slides.

While (j <= e)

    arrAll(i) = arrEven(j)

        j = j + 1

    i = i + 1

Wend

 

'Set each slide to transition after 2 seconds.

i = 1

While (i <= slideCount)

    With ActivePresentation.Slides(i).SlideShowTransition

        .AdvanceOnTime = msoCTrue

        .AdvanceTime = 2

    End With

    i = i + 1

Wend

 

'Create a custom slide show from the array of odd and even slides.

ActivePresentation.SlideShowSettings.NamedSlideShows.Add strShowName, arrAll

 

'Start the slide show

With ActivePresentation.SlideShowSettings

    .RangeType = ppShowNamedSlideShow

    .SlideShowName = strShowName

    .Run

End With

 

'Delete the custom slide show

For Each customShow In ActivePresentation.SlideShowSettings.NamedSlideShows

    customShow.Delete

Next customShow

 

End Sub

 

As usual, we start out by declaring a bunch of variables that will be used throughout our code. We then have this line of code:

slideCount = ActivePresentation.Slides.Count

All we’re doing here is using the Count property to find out how many slides are in the presentation, then storing that value in the variable slideCount. You’ll see how we use that in a moment. But first let’s look at a couple of variables we need to initialize:

i = 1

strShowName = "Alternate Slides"

 

Here we’re initializing some variables we’re going to need to set up our slide show. We first set the counter variable i to 1 (we’ll use that in some While loops in just a bit). We’ll also be using a named slide show to accomplish this challenge, so we’ve set the slide show name to Alternate Slides.

What exactly is a named slide show, and why are we using it? A named slide show is going to allow us to create a custom slide show without actually rearranging the slides within PowerPoint. It’s sort of a slide show within a slide show. We give this new slide show a name, tell it which slides we want to include, and in what order, then we can refer to that slide show by name and run it.

So let’s continue. We’re going to show all the odd-numbered slides first, then the even-numbered slides. That means that we first need to find out how many of each slide type (odd or even) we have. We start by setting a couple of temporary variables, then using those variables to determine how many odd-numbered slides we have and how many even-numbered slides:

temp1 = slideCount / 2

temp2 = slideCount Mod 2

The variable temp1 holds the number of slides divided by 2. So if there are 7 slides, temp1 is equal to 3. Keep in mind that we’re using integers here, so we don’t have any fractional values, just whole numbers. If there were an even number of slides in the presentation, we could simply divide the number of slides in half and know that one half are odd and one half are even. But we don’t know that, there might be an odd number of slides. To find out we set temp2 to the remainder of slideCount divided by 2, which is what the Mod function does. In our example of 7 slides, the remainder (Mod) of slideCount divided by 2 is 1.

Now we can determine how many even-numbered slides we have and how many odd-numbered slides. We have temp1 (3) even-numbered slides (slides 2, 4, 6) and temp1 plus temp2 (4) odd-numbered slides (3+1=4: slides 1, 3, 5, 7). Here’s how we determined that in our code:

o = temp1 + temp2

e = temp1

When you run a named slide show you need to provide an array that the slide IDs of each slide to show in the order you want to show them. We’re going to create that array by first creating an array of odd-numbered slides and then an array of even-numbered slides. We’ll then put those two arrays together to create the final slide show.

Let’s start with the array of odd-numbered slides:

j = 1

While (i <= o)

    arrOdd(i) = ActivePresentation.Slides(j).SlideID

    j = j + 2

    i = i + 1

Wend

We’re going to loop through the slides while our counter variable i is less than or equal to the number of odd-numbered slides in the presentation. Each time through the loop we add the slide ID of one slide to the array arrOdd:

arrOdd(i) = ActivePresentation.Slides(j).SlideID

Notice we’ve set another counter variable, j, to 1. This variable tells us which slide in the presentation we’re adding to the array. Thus, the first time through the While loop we add the SlideID of slide j (1) to array position i (1). We then increment j by 2 and i by 1:

j = j + 2

i = i + 1

Why did we increment j by 2? You got it: because we’re only adding odd-numbered slides, which means we add every other slide. As a result, the second time through the loop we’ll be adding the next odd-numbered slide, slide 3, to the array.

After we have all the odd-numbered slides in an arrOdd, we reset our counters and do the same with the even-numbered slides, adding them to arrEven:

j = 2

i = 1

While (i <= e)

    arrEven(i) = ActivePresentation.Slides(j).SlideID

    j = j + 2

    i = i + 1

Wend

Notice that our counter j started at 2; that’s because we’re doing even-numbered slides, which means we start with slide 2 and add slides 4, 6, etc. to the array.

Finally, we put these two arrays together into a new array (arrAll), first putting in everything from arrOdd and then everything from arrEven:

i = 1

j = 1

While (i <= o)

    arrAll(i) = arrOdd(i)

    i = i + 1

Wend

 

While (j <= e)

    arrAll(i) = arrEven(j)

    j = j + 1

    i = i + 1

Wend

You might have noticed that we didn’t reset our counter i between the two While loops. That’s because, after we add the odd-numbered slides to the new array, we want to start at the next position in that array and begin adding the even-numbered slides.

Now it’s time to set some properties for our slide show:

i = 1

While (i <= slideCount)

    With ActivePresentation.Slides(i).SlideShowTransition

        .AdvanceOnTime = msoCTrue

        .AdvanceTime = 2

    End With

    i = i + 1

Wend

Here we’re going through each of the slides and setting the transition properties using the SlideShowTransition object. We set the AdvanceOnTime property to msoCTrue, meaning we want the slides to transition based on a set amount of time, then we set the AdvanceTime property to 2, meaning that set amount of time is 2 seconds.

And then it’s time to actually create our named slide show. We do this by calling the Add method of the NamedSlideShows property:

ActivePresentation.SlideShowSettings.NamedSlideShows.Add strShowName, arrAll

We pass two parameters to the Add method: strShowName, the name of our slide show; and arrAll, the array containing the slide IDs of our show.

And now, finally, we can start the show:

With ActivePresentation.SlideShowSettings

    .RangeType = ppShowNamedSlideShow

    .SlideShowName = strShowName

    .Run

End With

We need to set two properties before the slide show can start: RangeType and SlideShowName. We set RangeType to ppShowNamedSlideShow to – yes, that’s right, to specify that we’re going to be running a named slide show. Then we have to specify which named slide show; we do that by setting SlideShowName to the name of the slide show (strShowName). Now all we have to do is call the Run method and our slide show will begin.

When we were testing our own solution, we ran into one problem: if we ran this subroutine to watch our slide show, then enjoyed it so much that we stopped it and ran it again, the code crashed. The reason it crashed was because we called the Add method to create the named slide show. That’s fine, except that, when we ran the code a second time, the Add method realized that a slide show by that name already existed. Because of that, the Add method refused to add another slide show by the same name and the whole thing crashed.

Rather than worry about checking for existing slide shows or making sure each slide show name was unique, we simply deleted all named slide shows at the end of the subroutine, and asked you to do the same:

For Each customShow In ActivePresentation.SlideShowSettings.NamedSlideShows

    customShow.Delete

Next customShow

Here we’re using a For loop to cycle through the collection of named slide shows and delete each one.

Whew! That was a pretty tough challenge for novices, wasn’t it? If Binder Clippy had been here to help it might have been a little easier.

Well, maybe not….

It’s true: we all need a break once in a while. A break from work, a break from the kids, a break from the in-laws...sometimes we just need to power down for a little while and take it easy. But sometimes this can be overdone. The breaks at work come a little too often, or the parents say that you’re not calling often enough.

Note. What? No, we don’t know anyone like that, and we definitely don’t know anyone who takes too many breaks at work. But we’re sure they’re out there somewhere.

Usually none of this is too bad, but what happens when your software takes too many breaks? That’s definitely trouble. And that’s exactly what happened in Challenge 9. We have a Word document that has way too many manual page breaks, and we need to get rid of some of them. As a matter of fact, we need to get rid of all of them. That should be easy, right?

But, then again, we didn’t want to make challenge too easy on you. Given the fact that you could have get rid of the manual page breaks by simply recording a macro, we threw in an extra requirement: you had to display a couple of message boxes along the way. Here’s how we accomplished all that:

Sub FindMyBreaks()

 

Dim objPages As Pages

 

'Retrieve a collection of all the pages in the document

Set objPages = ActiveDocument. _

    ActiveWindow.Panes(1).Pages

   

'Display a message box showing the number of pages in the doc.

MsgBox "Number of Pages: " & objPages.Count, vbOKOnly, "Document Pages"

 

'Ensures all instances of the search string are found, regardless of formatting

Selection.Find.ClearFormatting

 

'Find manual page breaks and paragraph markers that follow them and replace

' with nothing.

With Selection.Find

    .Text = "^m^p"

    .Replacement.Text = ""

    .Forward = True

    .Wrap = wdFindContinue

End With

Selection.Find.Execute Replace:=wdReplaceAll

   

'Retrieve a collection of all the pages with the manual page breaks removed.

Set objPages = ActiveDocument. _

    ActiveWindow.Panes(1).Pages

 

'Display a message box showing the number of pages in the doc.

MsgBox "Number of Pages: " & objPages.Count, vbOKOnly, "Document Pages"

 

End Sub

 

After declaring the one variable we’re going to need in this subroutine (objPages), we use the Pages collection to retrieve a collection of all the pages in the current document:

Set objPages = ActiveDocument. _

    ActiveWindow.Panes(1).Pages

Now we can accomplish the first step in the instructions for Challenge 9. We need to display a message box that states the number of pages in the current document. We do that by calling the MsgBox function like this:

MsgBox "Number of Pages: " & objPages.Count, vbOKOnly, "Document Pages"

We pass three parameters to MsgBox. The first is the text we want displayed within the message box:

"Number of Pages: " & objPages.Count

Here we’re creating a string that begins with “Number of Pages:”. We then tack on the number of pages. And how did we get the number of pages? Well, we just retrieved a collection of all the pages, so all we have to do at that point is count them. In other words, we just need to take a look at the Count property of the Pages collection.

Next it’s time to get to work removing those page breaks. The first thing we do is call the ClearFormatting method of the Find object:

Selection.Find.ClearFormatting

We do this just to make sure we find all our page breaks, no matter what formatting may have been applied to them.

In order to remove the page breaks, we need to find them all and then replace them with nothing. So the next thing we do is set up the find and replace criteria:

With Selection.Find

    .Text = "^m^p"

    .Replacement.Text = ""

    .Forward = True

    .Wrap = wdFindContinue

End With

Because all of our settings will be applied to the Selection.Find object, we put everything inside a With block; that way we don’t have to keep typing Selection.Find over and over again. (Hey, we’re busy people, we don’t have time for all that typing. Maybe later, when we get a break, we’ll think about doing some more typing.)

We set four properties for our find and replace. First we set the Text property, which specifies the string we want to search for:

.Text = "^m^p"

Wait a minute: didn’t we say we were looking for a page break, not the string ^m^p? Well, as it turns out, the character set ^m represents a manual page break. (How do we know this? In Word, open the Find and Replace dialog box. Click More>>, click Special, and then select Manual Page Break. You’ll see the characters ^m in the Find what text box.)

To solve this challenge (and receive your goldfish) that’s all you had to search for. But when we ran find and replace with ^m as the text string, we wound up with extra paragraph breaks in our text. Therefore we added ^p to our string, which represents a paragraph mark. Thus we’re searching for both a manual page break and the paragraph return that follows it.

Now that we’ve set the text we want to find, we set the value of the Replacement.Text property to the value we want to use as the replacement text. In our case we just want to delete the page break, so we replace it with an empty string (nothing):

.Replacement.Text = ""

We’re starting our find and replace from the beginning of the document, so we set the Forward property to True, saying we want to do a forward search (rather than start at the end and search backwards):

.Forward = True

Finally, we set the Wrap property to the constant wdFindContinue:

.Wrap = wdFindContinue

We’ve all seen this before: we’re somewhere in the middle of the document, we do a Find, and when we reach the end of the document Word pops up a box asking if we’d like to continue searching from the top. Setting the Wrap property to wdFindContinue is like clicking Yes to that dialog box. In other words, if our search reaches the end of the document before the whole document has been searched, the search will automatically continue from the beginning. This is nice, because we don’t want any stray message boxes popping up in middle of running our macro.

We’ve now set all the properties for our find and replace, which means it’s time to actually run it:

Selection.Find.Execute Replace:=wdReplaceAll

As you can see, we’re calling the Execute method on the Find object to run our find and replace. Note that we set the Replace parameter to wdReplaceAll; this ensures that every instance of the find string will be replaced, not just the first one.

Okay, we’ve done the hard part; now there’s only one thing left to do. Now that we’ve removed all the manual page breaks, we want to see how many pages we’re left with. That’s actually pretty simply. We just run the exact same code we ran at the beginning of the subroutine to retrieve all the pages, then output the page count to a message box:

Set objPages = ActiveDocument. _

    ActiveWindow.Panes(1).Pages

 

MsgBox "Number of Pages: " & objPages.Count, vbOKOnly, "Document Pages"

Because we’re calling the same code twice, it might be a good idea to put that section of code in a new subroutine and simply call the subroutine twice. But we put in the instructions for these challenges that we didn’t want you to do that (it’s much easier to test single subroutines); because of that, we asked you to break a useful coding standard for ease of testing. We just thought we’d mention that when you’re coding for real and not playing OfficePalooza games, this type of thing would be a good candidate for creating an additional subroutine.

That’s the lesson for today, and the end of Challenge 9. We’re going to take a break now. See you later.

You know, if we were a little smarter we would have made Challenge 10 an easy one; after 2 solid weeks of copying Visual Basic for Applications (VBA) subroutines from emails, pasting those subroutines into a Microsoft Office application, and then running that subroutine to make sure it actually worked, well, we definitely could have used a break here. But did we take the easy way out? Heck no; instead, Challenge 10 was the most difficult one to test, if for no other reason than the fact that it required at least two subroutines, subroutines which had to be stashed in two totally different places. (One, the NewGame subroutine, had to go in Module1; the other subroutine had to be attached to Sheet1.) What were we thinking?

Note. Well, obviously we weren’t thinking . After all, if we’d done even a little thinking we never would have agreed to do OfficePalooza in our spare time, something which meant we’d work all day at our real jobs and then go home and work all night on OfficePalooza. But, then again, OfficePalooza was a lot of fun, and we enjoyed seeing the different ways in which people approached the challenges. Maybe it’s a good thing that we don’t do much thinking after all! Something to think about, eh?

We also made our lives a bit more complicated by deciding to solve Challenge 10 without using global variables. Admittedly, we could have used global variables; there’s nothing in the instructions that say otherwise, and we happily accepted all the submissions that took that approach. However, global variables meant yet another piece of code that had to be placed in a specific spot in the workbook; that complicates our testing process. Had we been thinking, we would have said, “Do not use global variables in your submission.” But – well, you already know how we are when it comes to thinking.

Note. On top of that, we had a bad habit of posting the challenge and only then trying to determine if the challenge could actually be solved. We couldn’t rule out the use of global variables simply because, at the time the challenge was unveiled, we didn’t know for sure if you could solve the problem without using global variables. Wouldn’t it have been better to think about that before we posted the challenge?

You already know the answer to that question.

At any rate, global variables or no global variables, we eventually came up with a pair of subroutines that could play a rudimentary game of Hangman. And just what are those subroutines? Well, here’s one of them, the NewGame subroutine (the one we put in Module1):

Sub NewGame()

    Sheet1.Unprotect

     

    Range("B5:N6").Cells.Interior.ColorIndex = 2  

    Range("S5:S14").Cells.Interior.ColorIndex = 2

    Range("B8:N8").Cells.Interior.ColorIndex = 2

    Range("B8:N8").Cells.Value = ""

 

    Do While True

        intWordRow = Int((Rnd * 32154) + 1)

        strNewWord = Sheet2.Cells(intWordRow, 1).Value

        intLength = Len(strNewWord)

        

        If intLength > 6 And intLength < 14 Then

            For i = 1 To intLength

                Application.Cells(8, i + 1).Interior.ColorIndex = 6

                Application.Cells(8, i + 1).Font.ColorIndex = 6

                Application.Cells(8, i + 1).Value = UCase(Mid(strNewWord, i, 1))

            Next

            Sheet1.Protect

            Exit Do

        End If

    Loop

End Sub

 

The NewGame subroutine, as you can probably guess, is all about getting the worksheet ready for a new game. In order to play the game, you need to click on the list of available letters (cells B5 through N6). When you click on a letter, that particular cell should turn gray (indicating the letter has been chosen) and the value of that cell needs to be immediately available for use. The only way we can do that (well, that we know of anyway) is to protect the worksheet; if the worksheet is unprotected then clicking on a cell will simply select that cell. That’s not what we want. In addition to that, by protecting the worksheet we can keep people from clicking where they shouldn’t. (For example, people can’t select and delete any cells on the worksheet, something which could definitely wreak a little havoc on game play.)

OK, so if we need to have the worksheet protected then why does our very first line of code call the Unprotect method? Good question. In order to set up a new game we need to make some changes to the worksheet; for example, we need to reset the background colors of some of our cells. We can’t do that if the worksheet is protected; when that’s the case you can’t make any changes to the worksheet, even using VBA. The only way we can make changes is to unprotect the sheet. But don’t worry: the change in protection status will only be temporary.

Next we execute the following block of code:

Range("B5:N6").Cells.Interior.ColorIndex = 2  

Range("S5:S14").Cells.Interior.ColorIndex = 2

Range("B8:N8").Cells.Interior.ColorIndex = 2

Range("B8:N8").Cells.Value = ""

 

All we’re doing here (for the most part) is resetting the background colors of selected cells on the worksheet. For example, cells B5 through N6 are the letters you can use while playing the game; cells S5 through S14 represent the “scoreboard,” the portion of the game where we keep track of your incorrect guesses. In both cases, we set the ColorIndex property of each cell in the range to 2 (which just happens to be white). We also do the same thing with cells B8 through N8, the place where our “secret word” is displayed. In addition to changing the background color of these cells we also set the Value of each cell to an empty string; that simply clears the cell so that we can enter a new letter in there.

At this point we’re ready to select a new secret word. To carry out that chore, the first thing we do is set up a Do loop designed to run forever (or at least for as long as True is equal to True). Why do we need a loop here? Well, we put a couple stipulations on our word selection; in particular, we said that a word must have at least 7 letters but no more than 13 letters. We need this loop just in case, the first time around, we randomly choose a word that only has, say, 5 letters.

Note. As it turns out, our list of words – which we downloaded off the Internet – includes some two-word “words” (words separated by a blank space), plus words that have hyphens or other non-letter characters in them. Ideally, we would have written code that tossed out any words that included anything other than the letters A through Z; in the interest of keeping this subroutine short and sweet we opted not to do that. At least some of you did include code that guarded against selecting a secret word that included a blank space or a hyphen. All we can say is this: good for you!

Inside the loop we first call the Rnd function to select a random number between 1 and 32154. (Why 32154? Because we have that many words listed on Sheet2 of the workbook.) This line of code selects a value between 1 and 32154, then uses the Int function to convert that value to an integer:

intWordRow = Int((Rnd * 32154) + 1)

The selected value actually represents a row on Sheet2 of our workbook. Now that we have a row number we can use this line of code to grab the value of the word listed on row intWordRow, column 1:

strNewWord = Sheet2.Cells(intWordRow, 1).Value

After we’ve selected a word we can next use the Len function to determine the total number of characters in that word. Once that’s done we use this line of code to verify that the word has at least 7 (but no more than 13) characters in it:

If intLength > 6 And intLength < 14 Then

 

If the secret word doesn’t meet these criteria we simply pop back to the top of the loop and try again. If the secret word does meet these criteria then we execute the following block of code:

For i = 1 To intLength

    Application.Cells(8, i + 1).Interior.ColorIndex = 6

    Application.Cells(8, i + 1).Font.ColorIndex = 6

    Application.Cells(8, i + 1).Value = UCase(Mid(strNewWord, i, 1))

Next

 

All we’ve done here is set up a loop that runs from 1 (representing the first character in the secret word) to the length of that secret word (representing the last character in the word.) Inside the loop we start with the first cell in the range B8 through N8; as you no doubt figured out, cell row 8, column 2 (i + 1) is the same thing as cell B8. For this first cell we set the background color of the cell to yellow (6); we also set the Font color of the cell to yellow. Why do we bother with the font color? Well, as we noted earlier, we wanted to be able to play this game without needing to use global variables. One simple way of doing this (as some of you discovered) is to make the font color the same color as the background color of the cell. When the two colors are identical, we can then enter the correct letter in the cell; no one will be able to see it, but it will be there. This line of code (the first time through the loop) simply takes the first letter in our secret word and types it into cell B8.

We then loop around and repeat the process with the next cell in the range B8 through N8 and the next letter in the secret word.

And once that’s done we simply call the Protect method to reprotect our worksheet, then call Exit Do to exit the NewGame subroutine:

Sheet1.Protect

Exit Do

 

All things considered, that wasn’t too terribly bad, was it?

Next we need to create a single subroutine for actually playing the game. The best way to do that? Well, we’re not exactly sure if this is the best way to do that. But what worked for us was to add the following subroutine to Sheet1 in the workbook:

Public Sub Worksheet_SelectionChange(ByVal objTarget As Range)

    Set objRange = Range(objTarget.Address)

    Set objRange2 = Range("B5:N6")

  

    Set isect = Application.Intersect(objRange2, objRange)

   

    If Not isect Is Nothing Then

        Sheet1.Unprotect

        objTarget.Cells.Interior.ColorIndex = 16

       

        x = 0

       

        For Each objCell In Range("B8:N8").Cells

            If objCell.Value = objTarget.Cells.Value Then

                objCell.Font.ColorIndex = 1

                objCell.Interior.ColorIndex = 2

                x = 1

            End If

        Next

       

        If x = 0 Then

            For Each objCell In Range("S5:S14").Cells

                If objCell.Interior.ColorIndex <> 3 Then

                    objCell.Interior.ColorIndex = 3

                    Exit For

                End If

            Next

        End If

       

        Sheet1.Protect

    End If

    

    If Application.Cells(14, 19).Interior.ColorIndex = 3 Then

        strValue = ""

        For Each objCell In Range("B8:N8").Cells

            strValue = strValue & objCell.Value

        Next

        MsgBox "Sorry; you lose. The word was " & strValue & "."

        Sheet1.Protect

        Exit Sub

    End If

        

    intWordLength = 0

 

    For Each objCell In Range("B8:N8").Cells

        If objCell.Interior.ColorIndex = 6 Then

            intWordLength = intWordLength + 1

        End If

    Next

   

    If intWordLength = 0 Then

        MsgBox "Congratulations; you win!"

        Sheet1.Protect

        Exit Sub

    End If

End Sub

 

As you can see, this subroutine is designed to respond any time the selection changes on the worksheet (hence the reference to the Worksheet_SelectionChange event). Any time a player clicks a cell on Sheet1 (any cell on Sheet1) the SelectionChange event will be triggered, and this subroutine will run.

So what will this subroutine do when it does run? Well, for starters, it creates a pair of Range objects:

Set objRange = Range(objTarget.Address)

Set objRange2 = Range("B5:N6")

 

In the first line of code, we create a Range object that represents the cell that the player clicked; that’s what the objTarget.Address is for. And in line 2? In that line we create a range object that represents the collection of available letters (that is, cells B5 through N6).

That brings us to this line of code:

Set isect = Application.Intersect(objRange2, objRange)

Here we’re using the Intersect method to see if the cell that the user clicked intersects with the collection of available letters; in other words, did we click on a cell located in the range B5 through N6? If we did, then the object reference isect will be a valid object. And if we didn’t click on a cell located in range B5 through N6? In that case, isect will not point to a valid object.

Which explains why we next execute this line of code:

If Not isect Is Nothing Then

What we’re doing here is checking to make sure isect represents a valid object. If we don’t have a valid object (that is, if isect is equal to Nothing) then we simply exit the subroutine and wait for the player to click a new cell on the spreadsheet. And if we have a valid object? Well, in that case the first thing we do is run these two lines of code:

Sheet1.Unprotect

objTarget.Cells.Interior.ColorIndex = 16

 

In line 1 we, again, unprotect our worksheet. (Why? Because we need to make some changes to that worksheet.) We then set the ColorIndex of the selected cell to a dark gray (16); that way the player will be able to tell, at a glance, that he or she has already selected that particular letter.

After setting the value of the counter variable x to 0 (more on that in a minute) we execute this block of code:

For Each objCell In Range("B8:N8").Cells

    If objCell.Value = objTarget.Cells.Value Then

        objCell.Font.ColorIndex = 1

        objCell.Interior.ColorIndex = 2

        x = 1

    End If

Next

Admittedly, this is a tiny bit clunky; that’s because (we we mentioned earlier) we wanted to come up with a solution that required just two subroutines and no global variables. What we’re doing here is simply checking to see if the selected letter appears anywhere in the secret word. There are more elegant ways to do this; most of those ways would require the use of a global variable, however. Consequently, we do this the old-fashioned, brute force way: by setting up a For Each loop that checks each cell in the range B8 through N8 to see if the Value of any of those cells matches the value of the selected cell (that is, the letter that the player clicked on). This line of code checks to see if the values match:

If objCell.Value = objTarget.Cells.Value Then

If the values don’t match then we don’t do anything; if the values do match we run these 3 lines of code:

objCell.Font.ColorIndex = 1

objCell.Interior.ColorIndex = 2

x = 1

 

What are we doing here? Well, to begin with, we’re setting the font color for the cell to black (1); that’s going to allow the hidden value to “magically” appear on screen. After changing the font color we then change the background color of the cell to white; we do that so the player knows that he or she has correctly identified the letter that goes in that space. Finally, we set the value of x to 1; that helps us keep track of the fact that the selected letter does appear somewhere in the secret word.

Got all that? Good. Then here’s what we do next:

If x = 0 Then

    For Each objCell In Range("S5:S14").Cells

        If objCell.Interior.ColorIndex <> 3 Then

            objCell.Interior.ColorIndex = 3

            Exit For

        End If

    Next

End If

 

Remember how we set the value of x to 1 if the selected letter appears somewhere in the secret word? Well, if the letter doesn’t appear anywhere in the word that means that x will still be equal to 0 (and that the user made a wrong guess). In that case we need to change one of the cells in our scoreboard to red.

Ah, yet another good question: which cell do we need to change to red? To tell you the truth, we don’t know; this is another case where a global variable would come in handy. But even without a global variable we can still figure out which cell needs to be updated. How? By looping through the cells in range S5 through S14 and checking to see if the background color is red. If it is, then we go back to the top of the loop and try again with the next cell in the range. If it isn’t? Then we use this line of code to change the background color to red:

objCell.Interior.ColorIndex = 3

Like we said, not particularly elegant. But it works.

OK, so the user has selected a letter, we’ve determined whether or not that letter can be found in the secret word, and, if need be, we’ve updated our scoreboard. Now what do we do?

Well, first we need to check to see if the player has lost the game. How can we determine if the player has lost the game? Here’s one way. If the player has made 10 incorrect guesses then cell S14 will have a background color of red. We can check the background color of that cell using this line of code:

If Application.Cells(14, 19).Interior.ColorIndex = 3 Then

If the color is red then we run this block of code:

strValue = ""

For Each objCell In Range("B8:N8").Cells

    strValue = strValue & objCell.Value

Next

MsgBox "Sorry; you lose. The word was " & strValue & "."

Sheet1.Protect

Exit Sub

 

In the first four lines we simply loop through the values in cells B8 through N8 and use the letters found in each cell to reconstruct our secret word. (Needless to say, if we were using global variables we wouldn’t have to do this.) After the secret word has been stashed in the variable strValue we use this line of code to echo back the fact that the player has lost and, just to be nice, let him or her know what the secret word actually was:

MsgBox "Sorry; you lose. The word was " & strValue & "."

 

We then reprotect the worksheet and exit the subroutine.

But suppose the player hasn’t lost; does that mean the he or she has won? To be honest, we don’t know; however, we can figure that out by looping through the cells in range B8 through N8 and checking to see if the background color of any of those cells is yellow:

intWordLength = 0

 

For Each objCell In Range("B8:N8").Cells

    If objCell.Interior.ColorIndex = 6 Then

        intWordLength = intWordLength + 1

    End If

Next

 

If we happen to encounter a yellow cell we increment the value of the counter variable intWordLength by 1. When we’re done we’ll check the value of intWordLength. If intWordLength is equal to 0 that means we didn’t find any yellow cells; in turn, that means that the player has won. If intWordLength is anything but 0 that means that the player hasn’t guessed all the letters correctly and the game is still on. In that case, we don’t do much of anything except wait for the player to select another letter.

If our player has won then we congratulate them, reprotect the spreadsheet, and exit the subroutine; that’s what this hunk of code is for:

MsgBox "Congratulations; you win!"

Sheet1.Protect

Exit Sub

 

And, believe it or not, that’s all we have to do. Game over!

Or so we think.

This was one challenge that we actually had to think about. (Does that mean we didn’t think about the other challenges? Um, well ….) That’s because we were initially tempted to try and use Microsoft Office PowerPoint’s animation capabilities to try and create a very smooth, very realistic-looking race. But the more we thought about it, the more we realized that doing something like that was going to take a lot of thinking. Seeing as how thinking isn’t really our specialty, we thought better of it and decided to use a more brute force approach: we’d pick a horse, move it a little closer to the finish line; pick a horse, move it a little closer to the finish line; and so on. It’s not as elegant, but it works. And, as you’re about to see, it works with a minimal amount of code:

Private Sub CommandButton2_Click()

    Set myDocument = ActivePresentation.Slides(1)

 

    Do While True

        If myDocument.Shapes(6).Left > 525 Then

            MsgBox "Blue wins!"

            Exit Sub

        End If

 

        If myDocument.Shapes(7).Left > 525 Then

            MsgBox "Red wins!"

            Exit Sub

        End If

 

        If myDocument.Shapes(8).Left > 525 Then

            MsgBox "Green wins!"

            Exit Sub

        End If

 

        If myDocument.Shapes(9).Left > 525 Then

            MsgBox "Brown wins!"

            Exit Sub

        End If

 

        Randomize

        intDie = Int(Rnd() * 4) + 1

 

        Randomize

        intMover = Int(Rnd() * 10) + 1

 

        Select Case intDie

            Case 1

                myDocument.Shapes(6).IncrementLeft intMover

            Case 2

                myDocument.Shapes(7).IncrementLeft intMover

            Case 3

                myDocument.Shapes(8).IncrementLeft intMover

            Case 4

                myDocument.Shapes(9).IncrementLeft intMover

        End Select

 

        DoEvents

    Loop

End Sub

 

We start things out by creating an object reference to slide 1 in our presentation. (Which, now that we think about it, is the only slide in our presentation.) That’s what this line of code is for:

Set myDocument = ActivePresentation.Slides(1)

Believe it or not, that’s it for preparation and setup; at this point, we’re ready to start racing.

To conduct the race itself, we set up a Do Loop designed to run as long as True is equal to True. (And yes, that means if True is ever equal to False then our race will end prematurely. But that was a risk we were willing to take.) Inside the loop we have a series of four code blocks, code blocks designed to see whether any of our four horses have hit the finish line. For example, the block of code that tracks the progress of the blue horse (Shape 6) looks like this:

If myDocument.Shapes(6).Left > 525 Then

    MsgBox "Blue wins!"

    Exit Sub

End If

 

All we’re doing here is seeing if the left edge of our horse (as determined by the Left property) is greater than or equal to 525. If it is, that means that the blue horse has crossed the finish line and is the winner. In turn, we display the message “Blue wins!” and then exit the subroutine, a move that also brings the race to a close.

Note. How did we know that 525 was the magic number that would mean a horse has crossed the finish line? That was actually pretty easy: we simply placed one of the horses on the finish line and then wrote a temporary subroutine that displayed the value of the horse’s Left property.

And yes, as far as we know that is the way they determine the winner in real horse races.

These first four blocks of code tell us which horse crossed the finish line first. However, how do we actually get those horses to the finish line? Well, our solution was to move a random horse a random amount, and to repeat this process until one of the horses crosses the finish line. To help us move a random horse a random amount we execute these lines of code:

Randomize

intDice = Int(Rnd() * 4) + 1

 

Randomize

intMover = Int(Rnd() * 10) + 1

 

In the first two lines we’re rolling a four-sided die in order to determine which horse we’re going to move. (How in the world could you have a die with just four sides? You know, we never thought of that ….) To simulate the rolling of a four-sided die (we’d prefer to use the word “dice” as well, but our editor insists the dice is plural and die is singular) we first call the Randomize function; this “reseeds” the random number generator and helps ensure that we actually get a random number. (If you don’t call the Randomize function you run the risk of getting the same number each time you roll the dice. Uh, die.)

In the second line, we use the Rnd function to generate a random number between 1 and 4, inclusive. (We also use the Int function to ensure that we get an integer value.) The net effect? We’re going to get a 1, 2, 3, or 4, one number for each of our horses.

In the next two lines we generate a random number that determines the number of points we’re going to move the designated horse. In this case, we’re going to move the horse 1 point, 10 points, or any number of points in between.

That brings us to this block of code:

Select Case intDice

    Case 1

        myDocument.Shapes(6).IncrementLeft intMover

    Case 2

        myDocument.Shapes(7).IncrementLeft intMover

    Case 3

        myDocument.Shapes(8).IncrementLeft intMover

    Case 4

        myDocument.Shapes(9).IncrementLeft intMover

End Select

 

What we’ve done is set up a Select Case block that enables us to grab the desired horse and move him (or her; it’s hard to tell the difference with clip art horses) the correct number of points. As you can see, there’s nothing particularly complicated about the code. If our die came up with a 1 we move the blue horse (Shape 6) the correct number of points. (That number, of course, is stored in the variable intMover.) If our die came up with a 2 we move the red horse (Shape 7). If our die came up with a 3 – well, you get the idea.

After moving one of the horses we call DoEvents; this helps ensure that we actually see the race unfold onscreen. Otherwise we’d click the button, the subroutine would run, the horses would move to their final position and only then would the screen change. It’s way faster, true. But not nearly as exciting.

And then we simply pop back to the top of the loop and repeat the process until we have a winner.

Just like the Kentucky Derby.

 

 

So were we able to come up with a solution to challenge 8? Good question. As it turns out, we wrote the first half of our solution, then put it to the test, just to make sure everything was working correctly. When we did so, we discovered that not only was the code working, but the computer was able to guess the animal we were thinking of, too. (Yes, we know: spooky.) We tried it a few more times (10 or 11, to be a little more precise) and each time the computer was able to guess the animal. At that point we decided that our subroutine wasn’t half-finished after all; instead it was completely finished.

So does that mean that the subroutine is guaranteed to guess the correct animal each and every time you play the game? Well, we aren’t willing to go that far. But thanks in part to the fact that we have a relatively small number of animals in our database, it was good enough for us.

Note. If we really do have a relatively small number of animals in our database shouldn’t we have added more animals to that database? In answer to your question: no. After we committed ourselves to this challenge we only then went searching for a database of animal facts. When that search came up empty, that meant we had to create this database by hand. When you’re creating a database like this by hand, suddenly 71 animals seems like a huge amount.

Incidentally, if you’ve spent the past two weeks thinking, “Those OfficePalooza guys are so lazy; I bet they wouldn’t even create a database of animal facts by hand,” well, you were wrong. Not about us being lazy, mind you. But at least we did create a database of animal facts by hand.

So what solution did we come up, or half come up with? This one:

Private Sub Command8_Click()

    Set objDatabase = CurrentDb()

    Set objTable = objDatabase.CreateTableDef("WorkingTable")

 

    objTable.Fields.Append objTable.CreateField("ID", dbText)

    objTable.Fields.Append objTable.CreateField("Name", dbText)

    objTable.Fields.Append objTable.CreateField("Type", dbText)

    objTable.Fields.Append objTable.CreateField("Diet", dbText)

    objTable.Fields.Append objTable.CreateField("Nocturnal", dbBoolean)

    objTable.Fields.Append objTable.CreateField("Lifespan", dbText)

    objTable.Fields.Append objTable.CreateField("Weight", dbDouble)

    objTable.Fields.Append objTable.CreateField("Group", dbText)

    objTable.Fields.Append objTable.CreateField("Protection", dbText)

    objTable.Fields.Append objTable.CreateField("Gestation", dbDouble)

      

    objDatabase.TableDefs.Append objTable

   

    objDatabase.Execute ("INSERT INTO WorkingTable SELECT AnimalFacts.* FROM AnimalFacts;")

 

    objDatabase.TableDefs("WorkingTable").Fields("Group").Name = "GroupName"

 

    intAnswer = MsgBox("Is your animal nocturnal?", vbYesNo)

    If intAnswer = vbYes Then

        objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal = 0;"

    Else

        objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal <> 0;"

    End If

   

    intAnswer = MsgBox("Does your animal have a group name?", vbYesNo)

    If intAnswer = vbYes Then

        objDatabase.Execute "DELETE * FROM WorkingTable Where GroupName Is Null;"

    Else

        objDatabase.Execute "DELETE * FROM WorkingTable Where GroupName Is Not Null;"

    End If

   

    intAnswer = MsgBox("Is your animal threatened, endangered, or protected?", vbYesNo)

    If intAnswer = vbYes Then

        objDatabase.Execute "DELETE * FROM WorkingTable Where Protection Is Null;"

    Else

        objDatabase.Execute "DELETE * FROM WorkingTable Where Protection Is Not Null;"

    End If

 

    intAnswer = MsgBox("Is your animal a carnivore?", vbYesNo)

    If intAnswer = vbYes Then

        objDatabase.Execute "DELETE * FROM WorkingTable Where Diet <> 'Carnivore';"

    Else

        objDatabase.Execute "DELETE * FROM WorkingTable Where Diet = 'Carnivore'"

        i = i + 1

        intAnswer = MsgBox("Is your animal an omnivore?", vbYesNo)

        If intAnswer = vbYes Then

            objDatabase.Execute "DELETE * FROM WorkingTable Where Diet <> 'Omnivore';"

        Else

            objDatabase.Execute "DELETE * FROM WorkingTable Where Diet = 'Omnivore';"

        End If

    End If

 

    intAnswer = MsgBox("Is your animal a mammal?", vbYesNo)

    If intAnswer = vbYes Then

        objDatabase.Execute "DELETE * FROM WorkingTable Where Type <> 'Mammal';"

    Else

        objDatabase.Execute "DELETE * FROM WorkingTable Where Type = 'Mammal';"

    End If

 

    intQuestionsLeft = 15 - i

 

    Set objTempTable = objDatabase.OpenRecordset("WorkingTable", dbOpenDynaset)

    intRecordCount = objTempTable.RecordCount

    objTempTable.Close

  

    If intRecordCount < intQuestionsLeft Then

        Set objRecordset = objDatabase.OpenRecordset("WorkingTable")

        objRecordset.MoveFirst

        Do Until objRecordset.EOF

           intAnswer = MsgBox("Is your animal the " & objRecordset.Fields("Name"), vbYesNo)

           If intAnswer = vbYes Then

              MsgBox "I win!"

              objRecordset.Close

              objDatabase.TableDefs.Delete "WorkingTable"

              Exit Sub

           End If

            objRecordset.MoveNext

        Loop

     End If

          

    MsgBox "I give up; you win!"

   

    objRecordset.Close

    objDatabase.TableDefs.Delete "WorkingTable"

    objDatabase.Close

End Sub

 

As for how this code works, well, let’s see if we can figure that out. As you can see, we start out simple enough, using this line of code to create an object reference to the current database (Experienced_challenge_8.accdb):

Set objDatabase = CurrentDb()

After that simple and straightforward opening we then run smack dab into this line of code:

Set objTable = objDatabase.CreateTableDef("WorkingTable")

What’s going on here? Well, there are a number of different ways we could approach this issue. (In fact, nearly everyone who submitted a solution for challenge 8 attacked the problem from a slightly different angle.) Because we did have a relatively small database to work with, we decided that the easiest solution (and for some of us, the easiest solution is almost always the best solution) was to make a copy of the AnimalFacts table, ask a question, and then, based on the answer to that question, delete the appropriate animals from the copied table. For example, suppose we ask, “Is your animal a mammal?” If the answer is yes, then we’d delete all the animals in the copied table that are not mammals. If the answer is no, then we’d delete all the animals in the copied table that are mammals. After we ask enough questions we’ll eventually have just one animal left in the copied table: the animal you were thinking of.

Note. Or at least that was the plan. As you’ll see, though, we ended up taking a bit of a shortcut in the subroutine we actually wrote.

So how do we make a copy of the table AnimalFacts? Well, as far as we know, there’s no straightforward way to copy a table in Access. Therefore, we need to create the new table (which means specifying all the fields for the table) and then copy the data from AnimalFacts to our new table (which we christened “WorkingTable”). The CreateTableDef method simply creates a workspace of sorts where we can define the new table and all its fields.

Which just happens to be what this chunk of code does:

objTable.Fields.Append objTable.CreateField("ID", dbText)

objTable.Fields.Append objTable.CreateField("Name", dbText)

objTable.Fields.Append objTable.CreateField("Type", dbText)

objTable.Fields.Append objTable.CreateField("Diet", dbText)

objTable.Fields.Append objTable.CreateField("Nocturnal", dbBoolean)

objTable.Fields.Append objTable.CreateField("Lifespan", dbText)

objTable.Fields.Append objTable.CreateField("Weight", dbDouble)

objTable.Fields.Append objTable.CreateField("Group", dbText)

objTable.Fields.Append objTable.CreateField("Protection", dbText)

objTable.Fields.Append objTable.CreateField("Gestation", dbDouble)

 

All we’re doing here is recreating all the fields found in the AnimalFacts table. To do that, we use the CreateField method to specify a new field for our table. As you can see, CreateField takes two parameters: the field name (e.g., ID) and the datatype for the field (e.g., dbText, a constant that creates a field for storing string values). After defining the new field we then use the Append method to tack this new field onto the Fields collection of the WorkingTable table.

See how that works? And so why do we show 10 lines of code above? You got it: because the AnimalFacts table has 10 fields, and we want WorkingTable to replicate the structure of the AnimalFacts table.

After we’ve defined all the fields we can then Append the new table to the database:

objDatabase.TableDefs.Append objTable

 

At this point we have a new table – WorkingTable – that replicates the structure of the AnimalFacts table. However, there isn’t any actual data in WorkingTable. Our next line of code is designed to fix that problem:

objDatabase.Execute ("INSERT INTO WorkingTable SELECT AnimalFacts.* FROM AnimalFacts;")

 

This is just good old-fashioned SQL: the INSERT INTO query enables us to copy all the data from AnimalFacts and insert that data into WorkingTable. And because we’ve been careful to ensure that the field names (and field datatypes) are identical between the two tables that means that, for all intents and purposes, WorkingTable is now an exact duplicate of AnimalFacts.

But, uh, not for long. This might be difficult for you to believe, but we goofed when we created the AnimalFacts table. We named one of our fields Group, which we shouldn’t have done. (Why not? Because Group is a reserved word in the SQL query language, which meant we immediately ran into problems when we tried using the field name Group in our SQL queries.) Fortunately there’s an easy fix to the problem (when you make as many mistakes as we do you get pretty good at fixing problems). This line of code simply renames Group to GroupName:

objDatabase.TableDefs("WorkingTable").Fields("Group").Name = "GroupName"

Now why didn’t we think of that in the first place?

At this point, we’re ready to start playing Twenty Questions. As we noted earlier, the approach we decided upon relies on us asking a question, deleting the appropriate records from WorkingTable, then repeating the process until we either have exceeded the 20 allowed questions or until we’ve guessed the animal we’re thinking of. With that in mind, the first question we ask is this: Is your animal nocturnal? The code for handling this question, and the response, is shown below:

intAnswer = MsgBox("Is your animal nocturnal?", vbYesNo)

If intAnswer = vbYes Then

    objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal = 0;"

Else

    objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal <> 0;"

End If

 

As you can see, in the first line we’re simply using the MsgBox function to ask whether or not the animal is nocturnal. In addition to specifying the text of the question we also tacked on the constant vbYesNo; this adds Yes and No button to the resulting message box. We don’t just display that message box; we also grab the value of the button that was clicked (Yes or No) and stash it in the variable intAnswer.

And what do we do with the variable intAnswer? Well, for starters, we check to see if you clicked Yes; if so, then intAnswer will be equal to the constant vbYes:

If intAnswer = vbYes Then

Let’s say that you did click Yes. That can mean only one thing: the animal you’re thinking of must be nocturnal. If that’s the case, then we use this line of code (and a SQL DELETE query) to delete all the records from WorkingTable where the Nocturnal field is equal to 0. (When we copy the data over, the No values in the Nocturnal field get copied over as 0’s and the Yes values get copied over as -1’s.) That’s what this line of code is for:

objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal = 0;"

If intAnswer is not equal to vbYes then we delete all the record where Nocturnal is not equal to 0:

objDatabase.Execute "DELETE * FROM WorkingTable Where Nocturnal <> 0;"

 

Needless to say, nothing too fancy there.

Incidentally, we didn’t arbitrarily choose to start with the question “Is your animal nocturnal?” Instead, that was a calculated decision on our part. If you thumb through the AnimalFacts table (which would have been a good thing to do before you started writing your code) you would have noticed that there are only a handful of nocturnal animals. That’s why we started with this question: if the animal you were thinking of is nocturnal then we’ve pretty much won the game at this point.

Note. Why have we pretty much won the game at this point? Well, there are only 6 or 7 nocturnal animals in the database. We get 20 questions and we’ve asked 1; that means we still have 19 questions available to us, and only 6 or 7 possible animals that meet the description of the target animal. At this point we can simply start guessing animal names and be assured that we’ll get the answer right before we run out of questions.

After asking whether the animal is nocturnal we then ask whether the animal has a group name; whether the animal is threatened, endangered, or protected; and whether or not the animal is a carnivore. (And, if the animal is not a carnivore, then we ask if it happens to be an omnivore. With those two questions we can then determine whether we are dealing with a carnivore, an omnivore, or an herbivore.) Finally, we ask whether or not the animal is a mammal. Each time we ask a question, and each time we get back a yes or no, we delete the appropriate records from WorkingTable.

That brings us to this block of code:

intQuestionsLeft = 15 - i

 

Set objTempTable = objDatabase.OpenRecordset("WorkingTable")

intRecordCount = objTempTable.RecordCount

objTempTable.Close

 

What are we doing here? We’re glad you asked that question. In the first line, we’re simply determining how many questions we have left. We’ve asked at least 5, and possibly 6 if we had to ask if the animal is an omnivore. If we did ask the omnivore question then the counter variable i will be equal to 1; otherwise that counter variable will be equal to 0. We simply subtract the value of i from 15 to determine the number of questions remaining to us.

So we now have 15 (or possibly 14) questions left. Our next chore (which happens to encompass the next four lines of code) determines the number of animals (records) left in WorkingTable. As it turns out, Access has a somewhat annoying habit of reporting a record count different from the count you might expect. When you open a table you get back the number of records in that table. However, if you open a recordset using a query (e.g., “Select * From WorkingTable”) you back the number of records that were accessed. That’s always going to be 1 the first time you open that recordset. In other words, Access will always tell you that you have 1 record in the recordset. That’s really not all that helpful.

Because of that, we have to use a slightly-different route to determine the number of records in the table. We start out by using the OpenRecordset method to directly open the table WorkingTable. After the table is open we can then grab the RecordCount, stash the value in the variable intRecordCount, and then close the table.

So why do we need the record count anyway? Well, what we’re doing here is seeing if we have more questions left than we do animals. Just like with the question “Is your animal nocturnal?” if we have 15 questions left and there are just 11 animals left in WorkingTable, well, we’ve won; all we have to do is loop through the animals still remaining in WorkingTable until we guess the correct animal.

And just how do we do that? Well, for starters we reopen the table WorkingTable and then move the cursor to the first record in the resulting recordset. That’s what these two lines of code are for:

Set objRecordset = objDatabase.OpenRecordset("WorkingTable")

objRecordset.MoveFirst

 

As soon as we’ve done that we set up a Do Until loop that will continue to run until we reach the end of the recordset:

Do Until objRecordset.EOF

Inside this loop we use this line of code to guess the animal in question; to make sure you know which animal we’re talking about, we use the value of the Name field in our question:

intAnswer = MsgBox("Is your animal the " & objRecordset.Fields("Name"), vbYesNo)

If you answer No then we call the MoveNext record to move to the next record in the recordset and then try again. If you answer Yes, however, we run this block of code instead:

If intAnswer = vbYes Then

    MsgBox "I win!"

    objRecordset.Close

    objDatabase.TableDefs.Delete "WorkingTable"

    Exit Sub

End If

 

Here we simply echo back the fact that the computer won and then close the recordset. After that we use the Delete method to delete WorkingTable from the database, then use Exit Sub to exit the subroutine.

This, by the way, is the block of code we expected to use later in the script, after we had asked a few more questions. However, the first few times we tested the subroutine we found out that we didn’t have to ask any more questions: we always had fewer animals left in the table than we had questions remaining to ask. Does that mean that this subroutine will always win, considering the small number of animals in the database? Well, we can’t say that for sure. But it will win far more often than it will lose.

Which is a heck of a lot better than we usually do!

But what happens if we do have more animals in the table than we have questions remaining? Well, originally our intention was to ask a few more questions (e.g., “Does your animal weigh 100 pounds or more?”). Because we kept winning all the time, however, we decided to forego those additional questions. Instead, if we end up with more animals than questions we do what most people would do when faced with a difficult situation: we give up. Here’s the block of “I surrender” code that runs in that case:

MsgBox "I give up; you win!"

   

objRecordset.Close

objDatabase.TableDefs.Delete "WorkingTable"

objDatabase.Close

 

So is that taking the easy way out? Of course it is; would have expected anything other than that?