Data

In creating a table header that explains what the row and column values represent, a common approach is to use a cell with text separated by a diagonal line. This, first for me, video tutorial explains how.

For those who prefer a text explanation:

Format the cell “border” to add a diagonal from the left-top to the right-bottom (it’s one of the line choices in the Format Cells dialog box | Borders tab).

Then, type several spaces the literal Hours ALT+ENTER to create a newline in the text and then the literal Days.

Adjust the number of spaces before the literal Hours to get the desired effect.

An alternative, which is simple albeit crude, is to type Days space \ space Hours. {grin}

Tushar Mehta

I needed to copy a chart to a picture, but I wanted it to be an enhanced metafile (EMF) which is kind of like a vector graphic picture format. EMF graphics scale well when the page resizes.

A user would select the chart, run the macro and a dialog would ask them where to save the picture to – pretty simple, but handy!
It uses the clipboard to do the conversion.

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

Have you ever experienced the dreaded “Circular reference warning” popping up when you opened an Excel file or entered a formula?

Excel detects a circular reference when a chain of calculations visits the same cell more than once. Many users get (very) confused by this message and have no idea what it is about. I’ll tried to demystify that message in a new article:

Working with Circular references in Excel

The article contains these chapters:

Types of circular references

Simplistically speaking there are only a few types of circular references to discern:

Deliberate circular references

Accidental circular references

Calculation settings

If you want to work with circular references, the calculation settings of Excel are very important. This page gives you some pointers!

Properly setting up circular references

Whereas I am no fan of using circular references, they can be beneficial to your model and really solve the problem you are trying to solve. So here is some advice on how to properly work with them.

Reasons why circular references may not be detected

This page shows a couple of reasons why circles are not detected.

Enjoy!

Regards,

Jan Karel Pieterse

www.jkp-ads.com

A list of people who will enjoy chartsnthings, “A blog of data sketches from the New York Times Graphics Department. Maintained by @KevinQ.”

• People who say “data visualization” instead of “chart”
• People who can find fault in any chart that they didn’t make
• People who get lost in the minutia of charting psychology
• Me
• Maybe you

I’d like to make an assertion. If you have an open parenthesis preceded by a space, you should remove the parentheses. Here’s an example:

Sub test()

    Dim myCollection As Collection
    Dim myObject As Object
   
    myCollection.Add (myObject)
    myCollection.Add myObject
   
End Sub

When you put parentheses around an object, VBA evaluates that object and, absent a property, returns the default property. The first Add might error or might not work as expected. Here’s another example:

Sub test2()
   
    Dim dValue As Double
   
    dValue = 1.1
   
    Debug.Print (dValue)
    Debug.Print dValue
   
End Sub

In this case the parentheses don’t do any harm, but they’re still unnecessary. And finally:

Sub test3()
   
    Dim lValue As Long
   
    lValue = CLng(1.1)
   
End Sub

In this case there is no space before the open parenthesis, so it’s not just preferred, but necessary.

Can you think of a case where an open parenthesis preceded by a space is required or preferred?

var so = new SWFObject('https://www.regonline.com/documents/web/widgets/widget_001.swf', 'widget', '300', '115', '8', '');so.addParam('wmode', 'transparent');so.addVariable('url', 'http://www.regonline.com/eventinfo.asp?eventid=1064283');so.addVariable('date', '5/22/2012');so.addVariable('title', 'Excel Power Analyst Bootcamp Omaha');so.addVariable('location', 'Omaha, Nebraska');so.addVariable('cMain', '#336699');so.addVariable('cSecond', '#ff9900');so.write('flashContent22129');

Excel Power Analyst Bootcamp Omaha

It’s almost here. Sign-up today to get the early-bird discount. Seats are limited.

Hi all

I think this is the fix if you want to create a Outlook mail with a signature with or without a picture in it.

http://www.rondebruin.nl/mail/folder3/signature.htm

I hope it is working OK for everybody, if not mail me or post it here.

Other suggestions are also most welcome

Have a great day

There are instances when there are data series plotted on both the primary and secondary axes. For example, suppose we want to plot the two series A and B in Figure 1, with the elements in column B as the x-axis values. The A series will be a column cart on the primary axis and the B series will be a line chart on the secondary axis.

For a version in a page by itself (i.e., not in a scrollable iframe as below) visit http://www.tushar-mehta.com/publish_train/data_visualization/06%20Visual%20Effects.shtml

Tushar Mehta

I complete a timesheet every 14 days. I got tired of doing math in my head, so around August 13, 2010 I put a stop to it. Here’s what the date cell on my timesheet looks like now.

 

F2 to edit the cell, “+14″ and enter. It’s nowhere near too long as formulas go, but it’s starting to bother me. Time to consolidate. Select the 14s.

 

 

Press Control+= (F9 works too, but my muscle memory is control and equal sign)

 

 

Enter. Next pay period, my timesheet will look like this

 

I want to put a SQLite3 file in a shared Dropbox folder and run an Excel app with that as the backend database. I’m using the SQLite ODBC Driver and some VBA to drive a simple userform.

My theory is that the file access will be so short and infrequent that I won’t have any file locking problems.

Who wants to test it out? You need a Dropbox account, the aforementioned driver, and a copy of the workbook below. Oh, and Excel if you didn’t already figure that one out.

Install the driver. Leave a comment or send an email to dkusleika@gmail.com with your Dropbox info and I’ll share a folder with you. Then open the workbook and start adding and modifying records in the userform. Ideally, I’d like to coordinate a five minute period where a few of us agree to hammer on it and try to break it.

You can download SqliteContacts.zip

VBA Language Specifications at MSDN

Here’s a taste

A class is a declarative description of a set of objects that all share the same procedures and have a similar set of variables and events. The members of such a set of objects are called instances of the class. A typical class may have multiple instances but VBA also allows the definition of classes that are restricted to having only one instance. All instances of a specific class share a common set of variable and event declarations that are provided by the class but each instance has its own unique set of variables and events corresponding to those declarations.

It’s like reading the tax code. I can’t wait to get the Kindle edition.

via jtolle at StackOverflow

As I write, there are 1,055 LinkedIn groups with the keyword Excel. Not all of them are about software. Some exist to “support members to learn, grow, and excel.” So, I refined the search to include groups only in English. There are still 939 of those, but with some still learning, growing, and excelling. Moving then to Excel, English, and networking, there are 243 (and the learners are not yet gone). Using Excel, English, and Professional Group, it’s 409 groups, no learners, but also not the largest Excel group, either. Making it Microsoft Excel limits the list down to a mere 41.

Of the 939, the largest is Microsoft Excel Users with 16,677 members, and the smallest is the MS Pivot Table Discussion Group with a mere 8.

Which of these groups are worth writing about? I’m in Daniel Ferry’s Excel Hero group, but it’s listed three pages in, just approaching 2000 members. Dick is, too. What groups are you in, and why?

…mrt
©¿©¬

IFERROR is a worksheet function that was introduced in Excel 2007. It’s a catch-all error handler that you can wrap around a formula and return a different value if the formula evaluates to an error. Like most people, I was happy to see it to avoid the old

=IF(ISNA(VLOOKUP(...)),"Not Found",VLOOKUP(...))

construct. Two VLOOKUPs in the same formula is terribly inefficient, so this new worksheet function is welcome. Or is it. I read this over at StackOverflow.

It nearly makes me weep. I can think of no better way to get incorrect results than by wrapping every formula in IFERROR. It got me thinking about IFERROR in general, so I went and read about at office.microsoft.com. Here are the examples they give.

More weeping. Boy, I’m emotional today. It’s just an illustration, I know, but consider this

Microsoft’s method is on the left and mine is on the right. My formula is =IF(E3<>0,D3/E3,0). Microsoft’s example totally masks the fact that there’s an error in the first line. They’re trying to avoid a divide by zero error, but they’re using a sledge hammer on a push pin. If they want to catch more errors than just #DIV/0!, they should test for them explicitly.

As long as I’m writing about errors, another error handling construct that I dislike is this one.

=IF(ISERROR(VLOOKUP(...)),"Not Found",VLOOKUP(...))

I don’t like this because ISERROR will detect any kind of error when the only one that should be detected is NA. If there’s a #NUM! error in there, you’ll get the result “Not Found”, which is technically true but hardly helpful and sometimes damaging.

I’d like to have some guidelines about error checking in formulas. I’m the wrong guy to write these guidelines, but I’ll get the ball rolling.

1. Don’t use error handling without a specific reason
2. Test for the condition that would cause the error instead of error handling (examples: zero denominators, all IRR arguments with the same sign)
3. Wrap the smallest piece of a formula with error handling that is possible
4. Use the smallest scope error handling function possible (in order: ISNA, ISERR, ISERROR, IFERROR)

I’m sure you guys can poke some serious holes in that list, so please do. I guess my point is that errors are good. When you see an error returned in Excel, you know you made a mistake and you can fix it. If you don’t see it, you may not know and you may not fix it. Some errors are predictable and unavoidable, so we use the tools we have to deal with those errors in a responsible manner.

DDoE had a birthday on March 29th and I totally forgot about it. I would forget my own birthday if my wife didn’t buy me a present, so I don’t feel too bad about it. I often tell people that DDoE is the first Excel blog. Is that really true? I did a Google search and limited the dates to before March 29, 2004 and not much showed up. There were blogs that mentioned Excel, but not Excel blogs. Now I hear that blogs are dead and Tumblr is the new thing. I think I’ll skip that “revolution” and catch the next one.

I thought I’d check the stats eight years in and see what’s what.

Hmmm, seems I may have forgotten to put the Google Analytics javascript back in when the blog took a crap last fall. But that begs the question why isn’t it showing all zeros?

Thanks for reading. And thanks to the other authors for picking up the slack when I have nothing to say. As for the title, I can’t get the Flip-a-delphia song out of my head today.

Introduction

If you’re an engineer (like I used to be in a previous life), you have probably done your bit of experimenting. Usually, you then need a way to fit your measurement results with a curve. If you’re a proper engineer, you also have some idea what type of equation should theoretically fit your data.

Perhaps you did some measurements with results like this:

I’ve created an Excel file with which you can fit curves to your data, check out the article on my website:

Fitting curves to your data using Least Squares

Enjoy!

Regards,

Jan Karel Pieterse

http://www.jkp-ads.com/

If you’re using my VBHelpers add-in and haven’t made these fixes yourself, you may want to download the latest version at the end of this post.

Fix Public to Private Set

When I convert public variables to private and it’s an object, I would call the property Public Property Set, but I didn’t use the Set keyword in the actual variable assignment statement. So I fixed that.

Make FillFromRange use a Variant array

My old FillFromRange used a For Each rCell in rRng.Columns(1).Cells to loop through the cells. Now it read the range into a variant array and uses For i = LBound(vaValues,1) to UBound(vaValues,1). I never had a huge performance problem with it, but generated code should use best practices, don’t you think?

Insert Module Bug

Whenever I would insert a new module, it would put it in the project for the active workbook, not the active project. I finally decided to figure out the problem and fix it. The old code looks like this:

Sub InsertModule()
   
    Dim sName As String
    Dim vbc As VBComponent
    Dim vbp As VBProject
   
    sName = Application.InputBox("Enter Module Name")
   
    On Error Resume Next
   
    If Left$(sName, 1) = "M" Then
        Set vbc = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_StdModule)
        vbc.Name = sName
        vbc.CodeModule.InsertLines vbc.CodeModule.CountOfLines + 1, "Private Const msMODULE As String = """ & sName & "()"""
    ElseIf Left$(sName, 1) = "C" Then
        Set vbc = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_ClassModule)
        vbc.Name = sName
        vbc.CodeModule.InsertLines vbc.CodeModule.CountOfLines + 1, "Public " & Mid$(sName, 2, Len(sName)) & "ID As Long"
    ElseIf Left$(sName, 1) = "U" Then
        Set vbc = Application.VBE.ActiveVBProject.VBComponents.Add(vbext_ct_MSForm)
        vbc.Name = sName
    End If
   
End Sub

The InputBox call made the Excel Application active (rather than the VBE) which switches the active project to the active workbook. By storing the active project before I show the InputBox, it does the right thing.

Sub InsertModule()
   
    Dim sName As String
    Dim vbc As VBComponent
    Dim vbp As VBProject
   
    Set vbp = Application.VBE.ActiveVBProject
   
    sName = Application.InputBox("Enter Module Name")
   
    On Error Resume Next
   
    If Left$(sName, 1) = "M" Then
        Set vbc = vbp.VBComponents.Add(vbext_ct_StdModule)
        vbc.Name = sName
        vbc.CodeModule.InsertLines vbc.CodeModule.CountOfLines + 1, "Private Const msMODULE As String = """ & sName & "()"""
    ElseIf Left$(sName, 1) = "C" Then
        Set vbc = vbp.VBComponents.Add(vbext_ct_ClassModule)
        vbc.Name = sName
        vbc.CodeModule.InsertLines vbc.CodeModule.CountOfLines + 1, "Public " & Mid$(sName, 2, Len(sName)) & "ID As Long"
    ElseIf Left$(sName, 1) = "U" Then
        Set vbc = vbp.VBComponents.Add(vbext_ct_MSForm)
        vbc.Name = sName
    End If
   
End Sub

You can download VBHelpers.zip

A little history:
Lunch Pairing Objects
Populating Lunch Pairings
Lunch Pairing Constraints

To round out the Lunch Pairings series, I want to write about some of the design decisions and performance measurements.

Design

I’m not totally happy with the end result. This always happens when I have combinations and constraints. Combinations are fine. Constraints are fine. But combinations that must be constrained always make me loop more than I like. It just seems like there should be a better way. Maybe someday I’ll be smart enough to figure it out.

I started with a collection of contacts and I removed a contact from the collection when I added it to a lunch. I like this method of avoiding duplicates – make a list and remove the selected item from the list. The problem with this method is that it only serves one of my constraints – no lunch per contact per month. It doesn’t consider duplicates over two or ten months.

Another method I like to use when working with combinations is to make a list of every possible combination and choose randomly from the list. This works great with non-combination lists. There’s a lot of overhead with creating every possible combination and, when I had finished coding it, I realized that it’s a stupid idea. Rather than create every combination then test it, I could test it as I create it, which is what I ended up doing.

I’m still not supremely confident that the current method will procedure good results, particularly as the history of lunches grows. Time will tell, I guess.

Performance

My first iteration with the final design took 282 seconds to run. I never optimize code for speed until the end. Make it work, make it pretty, make it fast. In that order. Well, it was time to optimize and 282 seconds was not an acceptable run time.

Well it’s pretty obvious where to start. My AttendeeList property returned a delimited string of sorted contact names. Calling that 3.5 million times was costly, to say the least. Once a lunch was create, its contacts did not change. There was no need for me to keep calculating that property every time. I made the property a write-once, read-many property.

Public Property Get AttendeeList() As String
   
    Dim aList() As String
    Dim i As Long, j As Long
    Dim sTemp As String
    Dim sReturn As String
    Dim lCnt As Long
           
    If Len(msAttendeeList) = 0 Then
        ReDim aList(1 To Me.Attendees.Count)
        For i = 1 To Me.Attendees.Count
            lCnt = lCnt + 1
            aList(lCnt) = Me.Attendees.Contact(i).FullName
        Next i
       
        For i = LBound(aList) To UBound(aList) - 1
            For j = i To UBound(aList)
                If aList(i) > aList(j) Then
                    sTemp = aList(i)
                    aList(i) = aList(j)
                    aList(j) = sTemp
                End If
            Next j
        Next i
       
        For i = LBound(aList) To UBound(aList)
            sReturn = sReturn & aList(i) & "|"
        Next i
       
        sReturn = Left$(sReturn, Len(sReturn) - 1)
        msAttendeeList = sReturn
    End If
   
    AttendeeList = msAttendeeList
   
End Property

The first thing the property does is check for the existence of msAttendeeList, the module level variable. If it’s there, it simply returns it. If it’s not there, then it hasn’t been calculated yet. The string is created and stored so future calls don’t have to calculate. This got my run time down to 60 seconds.

The next lowest hanging fruit was checking to see if there are any matches. Here’s what that property looks like now – I cleaned it up for the previous posts.

Public Property Get AttendeeMatch(clsLunch As CLunch, lMatchMax As Long) As Boolean
   
    Dim vaMe As Variant
    Dim vaLunch As Variant
    Dim i As Long, j As Long
    Dim lCnt As Long
    Dim clsMeAtt As CContact
    Dim clsLunchAtt As CContact
   
'    For Each clsMeAtt In Me.Attendees
'        For Each clsLunchAtt In clsLunch.Attendees
'            If clsMeAtt.ContactID = clsLunchAtt.ContactID Then
'                lCnt = lCnt + 1
'                If lCnt >= lMatchMax Then Exit For
'            End If
'        Next clsLunchAtt
'        If lCnt >= lMatchMax Then Exit For
'    Next clsMeAtt
   
    vaMe = Split(Me.AttendeeList, "|")
    vaLunch = Split(clsLunch.AttendeeList, "|")

    For i = LBound(vaMe) To UBound(vaMe)
        For j = LBound(vaLunch) To UBound(vaLunch)
            If vaMe(i) = vaLunch(j) Then
                lCnt = lCnt + 1
            End If
        Next j
    Next i
   
'    For i = LBound(vaMe) To UBound(vaMe)
'        If InStr(1, clsLunch.AttendeeList, vaMe(i)) > 0 Then
'            lCnt = lCnt + 1
'        End If
'    Next i
   
    AttendeeMatch = lCnt >= lMatchMax
   
End Property

I used the Split function on both lunch’s attendee lists and roll through the array looking for matches. First, I tried to use Instr instead of split (that’s the lower commented out area).

Nope, that’s worse. Next I try going to a For Each loop (the upper commented area).

Oh, that’s way worse. Back to my original Split way and my 60 second run time. Then I figured it out. Sometimes, often times, I get so hung up on the Total column that ignore the Count column. Once I worked on lowering the count, everything got a lot faster. How to lower the count of the match calls? Find matches sooner rather than later. Instead of For Each looping through the lunches, I looped through in reverse. I was far more likely to have a match on a lunch from the current month because the constraints are tighter. So by checking the most current lunches first, I reduce the overall number of calls. Here’s the IsRepeat property that loops through the lunches backward.

Public Property Get IsRepeat() As Boolean
   
    Dim clsLunch As CLunch
    Dim bReturn As Boolean
    Dim i As Long
   
    For i = gclsLunches.Count To 1 Step -1
        Set clsLunch = gclsLunches.Lunch(i)
       
        If clsLunch.LunchDate = Me.LunchDate Then
            If clsLunch.AttendeeMatch(Me, 1) Then
                bReturn = True
                Exit For
            End If
        End If
       
        If clsLunch.IsWithin(Me.LunchDate, 2) Then
            If clsLunch.AttendeeMatch(Me, 2) Then
                bReturn = True
                Exit For
            End If
        End If
       
        If clsLunch.IsWithin(Me.LunchDate, 10) Then
            If clsLunch.AttendeeMatch(Me, 3) Then
                bReturn = True
                Exit For
            End If
        End If
    Next i
   
    IsRepeat = bReturn
   
End Property

That got me down to a manageable 13 seconds. That I can live with.

I need to get the code to PerfMon because there are two things I don’t like about it. First, it doesn’t respect my indented Exit Sub lines. Second, I would rather if it kept a history of output (append rather than output to a text file) and allowed me to comment on them. I’ve done that here by copying the results to the right and writing a comment before re-importing the sheet.

You can download LunchPairings.zip, which contains the workbook with the code and the workbook with the PerfMon results.

In a LinkedIn group, someone wanted to access data in a shared server-based workbook that contained a protected sheet with locked cells that were not selectable. In addition to sharing an automated way of doing this, this post contains two other embedded tips.

The solution, as many know, is to enter a formula in the destination worksheet that references the source cell, e.g., =’C:\Temp\[Book2.xlsx]Sheet1′!$E$5

Given the high likelihood of making an error in entering long formulas, I decided to see if I could automate the process.

Tip 1: In doing so, I discovered that under certain circumstances Excel will make a very interesting correction. If the source workbook has a single worksheet, then one can use any sheet name in the formula and Excel will change it to the correct one! So, if book2.xlsx contains a single sheet named Sheet1, and one were to enter the incorrect formula =’C:\Temp\[Book2.xlsx]abc’!$E$5, Excel will correct it to =’C:\Temp\[Book2.xlsx]Sheet1′!$E$5.

That aside, since the cells in the source worksheet are not selectable, one cannot construct the formula using click-and-point. So, I decided that as long as one wants the values from the source cells to be in the same cell in the destination worksheet, why not select the cells in the destination worksheet? The code below does just that. Also, there is no longer a need to open the shared server workbook at all!

One final note. I rarely use so many different interactions with the consumer, preferring a userform. But, the below is easier to share.

Tip 2: The Inputbox method gets a single piece of information from the user, e.g., the sheet name in the code below. If the user were to cancel the resulting dialog box, the method returns False. The usual way to check for this is to compare the returned value with “False”. But, this precludes a legitimate response of “False”! So, I tend to check if the returned type is a boolean. The same applies to the GetOpenFilename method.

Enter the code below is a standard VBE module. Then, open the destination worksheet (or create a new one), and then run the linkToExternal subroutine. It will ask for the source workbook, the source worksheet, and then the destination cells. The code will add in each destination cell a formula that links to the same cell in the source worksheet.

Option Explicit

Sub linkToExternal()
    If ActiveWorkbook Is Nothing Then
        MsgBox "Please open the destination workbook before running this macro"
        Exit Sub
        End If
    Dim FName
    FName = Application.GetOpenFilename( _
        Title:="Please select the source workbook")
    If TypeName(FName) = "Boolean" Then Exit Sub
    FName = Left(FName, InStrRev(FName, Application.PathSeparator)) _
        & "[" & Mid(FName, InStrRev(FName, Application.PathSeparator) + 1) _
        & "]"
    Dim SheetName
    SheetName = Application.InputBox("Please enter the name of the source sheet", Type:=2)
    If TypeName(SheetName) = "Boolean" Then Exit Sub
    FName = "='" & FName & SheetName & "'!"
    Dim Rng As Range
    On Error Resume Next
    Set Rng = Application.InputBox( _
        "Please select the destination cells into which you want the corresponding source cell values", _
        Type:=8)
    On Error GoTo 0
    If Rng Is Nothing Then Exit Sub
    Dim aCell As Range
    For Each aCell In Rng
        aCell.Formula = FName & aCell.Address(True, True)
        Next aCell
    End Sub

Lunch Pairings Classes
Populating Lunch Pairings

My method for creating proposed lunches is to add three random contacts to make a lunch, then see if that lunch meets the conditions. If it does, I add it to the lunches collection class. If not, I try another combination. The portion of the FillMonth method that does this looks like:

If Not clsLunch.IsRepeat Then
    Me.Add clsLunch
    bAdded = True
    lCnt = lCnt + 1
End If

I’ve put all my previously mentioned conditions into one property called IsRepeat.

Public Property Get IsRepeat() As Boolean
   
    Dim clsLunch As CLunch
    Dim bReturn As Boolean
    Dim i As Long
   
    For i = gclsLunches.Count To 1 Step -1
        Set clsLunch = gclsLunches.Lunch(i)
       
        If clsLunch.LunchDate = Me.LunchDate Then
            If clsLunch.AttendeeMatch(Me, 1) Then
                bReturn = True
                Exit For
            End If
        End If
       
        If clsLunch.IsWithin(Me.LunchDate, 2) Then
            If clsLunch.AttendeeMatch(Me, 2) Then
                bReturn = True
                Exit For
            End If
        End If
       
        If clsLunch.IsWithin(Me.LunchDate, 10) Then
            If clsLunch.AttendeeMatch(Me, 3) Then
                bReturn = True
                Exit For
            End If
        End If
    Next i
   
    IsRepeat = bReturn
   
End Property

I loop through all the existing lunches, from both past months and those from the month I’m working on. In the first test, I check to see if the lunch is in the same month as the proposed lunch. Then I check if any of the attendees match via the AttendeeMatch property.

Public Property Get AttendeeMatch(clsLunch As CLunch, lMatchMax As Long) As Boolean
   
    Dim vaMe As Variant
    Dim vaLunch As Variant
    Dim i As Long, j As Long
    Dim lCnt As Long
    Dim clsMeAtt As CContact
    Dim clsLunchAtt As CContact
   
    vaMe = Split(Me.AttendeeList, "|")
    vaLunch = Split(clsLunch.AttendeeList, "|")

    For i = LBound(vaMe) To UBound(vaMe)
        For j = LBound(vaLunch) To UBound(vaLunch)
            If vaMe(i) = vaLunch(j) Then
                lCnt = lCnt + 1
            End If
        Next j
    Next i
   
    AttendeeMatch = lCnt >= lMatchMax
   
End Property

This property is bit weird. There are some unused variables in there, for one. In a later post, I’ll talk about the performance problems I had and how I tried to reduce execution time. The AttendeeList property returns a string of contact names, pipe delimited, and sorted by first names. Now that I look at it, I don’t think those names need to be sorted, but I use that property later where they do, so it’s there.

I’m checking my condition that a contact only have one lunch per month. I passed in a “1″ to lMatchMax so that if there was even one match, the lunch gets booted.

For my next condition, I test to make sure that no two contacts are in a lunch in the last two months. That starts by testing whether the lunch is within the last two months via the IsWithin property. Terrible name, I know.

Public Property Get IsWithin(dtLunch As Date, lMonths As Long) As Boolean
   
    IsWithin = dtLunch > DateSerial(Year(Me.LunchDate), Month(Me.LunchDate) - lMonths, 0)
   
End Property

If it passes this test, I call AttendeeMatch again, but this time with a lMatchMax of 2.

The final condition is that no three contacts are in the same group in the last ten months. It’s the same as the previous condition except that IsWithin gets passed a 10 and AttendeeMatch gets passed a 3.

Finally, I write the lunches by month to a range. Back in the main calling procedure,

    For lMonth = lFIRST To lLAST
        vaWrite = gclsLunches.LunchesByMonth(lMonth).RangeOutput
        wshLunch.Cells(wshLunch.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
    Next lMonth

The RangeOutput property returns a two-dimensional array

Public Property Get RangeOutput() As Variant
   
    Dim aReturn() As String
    Dim clsLunch As CLunch
    Dim lCnt As Long
    Dim i As Long
    Dim lAttCnt As Long
   
    ReDim aReturn(1 To Me.Count, 1 To 5)
   
    For Each clsLunch In Me
        lCnt = lCnt + 1
        lAttCnt = 0
        aReturn(lCnt, 1) = clsLunch.LunchMonth
        aReturn(lCnt, 2) = clsLunch.Attendees.Contact(clsLunch.Facilitator).FullName
        aReturn(lCnt, 5) = clsLunch.AttendeeList
        For i = 1 To clsLunch.Attendees.Count
            If i <> clsLunch.Facilitator Then
                lAttCnt = lAttCnt + 1
                aReturn(lCnt, 2 + lAttCnt) = clsLunch.Attendees(i).FullName
            End If
        Next i
    Next clsLunch
   
    RangeOutput = aReturn
   
End Property

The Facilitator is listed first, then the other two attendees. I also spit out the sorted AttendeeList so I can do a countif and make sure I didn’t screw anything up. And I screwed up plenty.

Next up, I’ll discuss some of the performance problems I had and how I solved them.

Last month I read an article about a job interviewer who played TicTacToe with his applicants. It was like an instant shared round of golf, and the interviewer put great store in the correlation of good hires with good players. So in case any DDoE readers might run into that guy, here is TicTacToe (or Noughts and Crosses as it’s known across the pond) in a user form suitable for practice.
 

 
There are several XL versions out there in the wide world of web (though not too many in a user form) and this is just the latest. It’s a refresh of my first XL code that wasn’t a tutorial, written in XLM too many moons ago.

You can set if you go first or second, set if you are X or O, and set if XL plays hard (don’t know if it can be beat), medium (can be beat), or dumb (as in very dumb—makes random legal moves). It’ll keep score. If you play well, you can’t lose. If XL plays well, you can’t win.
 

 
Start refreshes the game, and Reset takes you back to where you can adjust the mode of play. It looks different, but it works fine on a Mac with XL 2011. Its default is the Comic Sans MS font. If you’re playing second, you can control the start square for XL by clicking Start until XL randomly picks the square you want it to use.

The form is available here. After importing, it needs just a one-line macro to run.

Sub TicTacToe()
   frmTicTacToe.Show
End Sub

Presumably, that guy giving the interview plays TicTacToe well, so you won’t win. I don’t think you want to lose, either. Or maybe just lose one out of three. I think I read about it on the BBC’s iPad service. If you remember where it was, please comment. And if you beat it with XL playing hard, please say how. Your game is captured in the VBE’s Immediate Window.

Provided as a public service to Dick’s readers.

…mrt
©¿©¬