Archive for April, 2009

Testing VBA Code – Part 4

In Part 3, we looked at testing a worksheet as an Excel object plus associated code (in the sheet module). This idea is similar to that in object-oriented testing practice, where the unit of testing is a single object (instance of a class), or a group of closely related objects.

In a previous set of postings on Classes, we defined a couple of Class modules, Job and Resource, instances of which acted as adapters on to a worksheet (rather than having operational code in the sheet module itself). This example also used a List class as a ‘helper’ – basically a linked data structure with Add and Remove operations. So, how do we test such Classes?

For simplicity, let’s stick with the List class (since there’s no persistence to the worksheet, as there was with Job and Resource classes).

The test ‘script’ basically consists of:

  • create an instance of the class
  • perform operations on the object
  • check the class invariant after creation and after each operation
  • check the post-condition of each operation
  • use the ‘state query’ functions or properties (e.g. First, Count) to inspect the object.

For collection-like objects, there are often sequences of operations that can be checked for ‘circularity’ – e.g. li.Add(val).Last = val.

Here’s the ‘short form’ for the class – that is, just the member headers plus assertions:

'Warning: not complete VBA syntax!

Dim liHead As ListItem
Dim liTail As ListItem
Dim licount As Integer
Const separator As String = "/"

Public Function Invariant() As Boolean
    Invariant = _
        (licount = 0 And liHead Is Nothing And _
			liTail Is Nothing) Or _
        (licount = 1 And Not liHead Is Nothing And _
			liHead Is liTail) Or _
        (licount > 1 And Not liHead Is Nothing And _
            Not liTail Is Nothing And Not liHead Is liTail)
End Function

Public Property Get Count() As Integer

Function IsEmpty() As Boolean

Function First() As Variant
    If pre Then AssertPre "List.First", (Not IsEmpty)

Function Last() As Variant
    If pre Then AssertPre "List.Last", (Not IsEmpty)

Sub SetLast(val)
    If pre Then AssertPre "List.SetLast", (Not IsEmpty)
    'post: GetNth(Count) = val

Private Function NthItem(n As Integer) As ListItem

Function GetNth(n As Integer) As Variant
    If pre Then AssertPre "List.GetNth", _
		     (Count > 0 And n > 0 And n <= Count) 

Sub SetNth(n As Integer, val)
    If pre Then AssertPre "List.SetNth", _
		     (Count > 0 And n > 0 And n <= Count)
    'post: GetNth(n) = val 

Sub Add(val)
       'post: count = old count + 1 

Sub Remove()
'post: (old count > 0 and count = old count - 1) Or
'        (old count = 0 and count = 0)

Function ToString() As String
'post: Len(ToString) >= count * Len(separator)

Notes:

  • ListItem is just a Value + NextItem pair.
  • The Invariant is given as a function.
  • The post-conditions are just comments: they will be evaluated in the test code. ‘old’ refers to the value of an expression before execution of the operation.
  • In line with the suggestion in Part 3, the preconditions are given as executable code (‘pre’ is a global switch for evaluation).

Following our general approach, the test code goes in an ordinary module ‘TestList’, corresponding to the Class module. The test module contains a single Run procedure (obviously you could break this down into sub-tests). TestSetup and TestWrapup are calls to general facilities in a ‘Test’ module.

The code is verbose of necessity, but pretty simple and repetitive:

Public Sub Run()
    TestSetup "List"

    Dim li As List    'the object under test
    Dim oldcount As Integer
    Dim val As Integer, val2 As Integer   'some values

    Set li = New List

    AssertInv li
    AssertEqual li.Count, 0
    oldcount = li.Count
    '--------------------------------------------
    val = 3
    li.Add val

    AssertInv li
    AssertEqual li.Count, oldcount + 1      'post Add
    AssertEqual li.First, val
    AssertEqual li.Last, val
    AssertEqual li.GetNth(li.Count), val
    oldcount = li.Count
    '--------------------------------------------
    val = 4
    li.SetNth 1, val

    AssertInv li
    AssertEqual li.GetNth(1), val           'post SetNth
    AssertEqual li.ToString, "/" & val
    '--------------------------------------------
    val = 5
    li.SetLast val

    AssertInv li
    AssertEqual li.GetNth(li.Count), val    'post SetLast
    '--------------------------------------------
    val2 = 6
    li.Add (val2)

    AssertInv li
    AssertEqual li.Count, oldcount + 1      'post Add
    AssertEqual li.First, val
    AssertEqual li.Last, val2
    AssertEqual li.GetNth(1), val
    AssertEqual li.GetNth(li.Count), val2
    AssertEqual li.ToString, "/" & val & "/" & val2
    oldcount = li.Count
    '--------------------------------------------
    li.Remove

    AssertInv li
    AssertEqual li.Count, oldcount - 1     'post Remove
    AssertEqual li.First, val
    AssertEqual li.Last, val
    AssertEqual li.GetNth(1), val
    AssertEqual li.ToString, "/" & val
    oldcount = li.Count
    '--------------------------------------------
    li.Remove

    AssertInv li
    AssertEqual li.Count, oldcount - 1      'post Remove
    AssertEqual li.Count, 0
    AssertEqual li.ToString, ""
    oldcount = li.Count
    '--------------------------------------------
    li.Remove

    AssertInv li
    AssertEqual li.Count, 0
    AssertEqual li.ToString, ""

    TestWrapup
End Sub

AssertInv is just another general procedure in module Test. If Invariant is a standard name, then we just need to pass in the object:

Public Sub AssertInv(obj As Object)
    Dim msg As String

    If Not obj.Invariant Then
        msg = "*** Inv " & TypeName(obj) & " failed"
        Debug.Print (msg)
        errcount = errcount + 1
    End If
End Sub

Now, we haven’t investigated the question of how much testing is enough testing. There’s no simple answer, of course, but having a standard approach and framework into which to put testing code makes it easy to do testing alongside development, and to do both in small increments. Any change or extension to the List class is matched by changes or extensions to TestList.Run. If we find a bug that’s not been picked up by the tests, then we add some tests so that it is, then we fix the bug. We come back to the project after a year, say, and we can immediately discover whether it’s working or not (bad case of Software Rot…). It really can be most productive.

Finally, a doff of the hat towards the Eiffel language, the only one that fully integrates and supports assertions: preconditions, postconditions and invariants. These are part of the primary code, and can (optionally) be evaluated at run-time. This almost removes the need for separate unit testing code, allowing you to concentrate on system-level or architectural testing. Meanwhile, back with VBA …

Testing VBA Code – Part 3

In Part 2, we introduced the idea of writing tests in code, and applied this to a trivial worksheet function. However, more interesting, and more error-prone, is code that alters our worksheets. For example, we might have a procedure that adds a new record to a list (possibly called from the OK button of a data-entry form). Let’s say that the worksheet, called “Records”, looks like this:

wsupdate_ws

Id is an ‘autonumber’ field; Name is entered by the user; Date is today’s date. To keep things simple, we’ll get Name from the user using an InputBox, rather than a proper form.

Sub NewRecord()
    Dim name As String
    name = InputBox("Please enter a name")
    Records.AddRecord (name)
End Sub

Now, it seems to me that the place to put AddRecord is the Records worksheet – that is, the worksheet module (renamed from the default “Sheet1″ to “Records”). Here it is:

Public Sub AddRecord(name As String)
        'pre Len(name) > 0
        'post: RowCount = old RowCount + 1

    Dim id As Integer, rownum As Integer

    id = NewId
    rownum = NewRow

    Range("A" & rownum).Value = id
    Range("B" & rownum).Value = name
    Range("C" & rownum).Value = Date

End Sub

Note the pre- and post-condition comments, discussed in an earlier posting. More on these later.

NewId and NewRow are trivial functions, based on the size of the data region: RowCount.

Public Function Records() As Range
        'number of filled rows, including header
    Set Records = Range("A1").CurrentRegion
End Function

Public Function RowCount() As Integer
    RowCount = Records.Rows.Count
End Function

Public Function MaxId() As Integer
    MaxId = RowCount - 1     'allow for headers
End Function

Public Function NewId() As Integer
    NewId = MaxId + 1
End Function

Public Function NewRow() As Integer
    NewRow = NewId + 1     'allow for headers
End Function

So, having put the interesting code in the worksheet module, this is what we want to test. In other words, we want to test the worksheet as object + code.

More specifically, we want to test:

  • the object’s invariant
  • the operation post-conditions

(we’ll come back to the pre-conditions later).

We can define the invariant as a Boolean function. In this case, the worksheet always has at least 1 row (the headers), and the Name fields cannot be empty:

Public Function Invariant() As Boolean
    Invariant = _
        RowCount >= 1 And _
        WorksheetFunction.CountA(Range("B:B")) = RowCount
End Function

We should probably check columns A and C, as well. This invariant holds whenever the worksheet is in a ‘stable state’. For example, it’s allowed not to hold when we’re part way through adding a record, and we’ve added the Id (increasing rowcount), but have not yet added the Name (which is therefore blank).

Now we come to the issue of what is in the worksheet when we run the tests. In this case, it’s simplest to start with an empty worksheet (i.e. containing only the header row), and then add records. So at the start of our Run procedure, we need to call a Clear procedure:

Public Sub Clear()
        'post: rowcount = 1
    Cells.Clear
    Range("A1").Value = "Id"
    Range("B1").Value = "Name"
    Range("C1").Value = "Date"
End Sub

This has it’s own post-condition, which itself needs testing.

Obviously, we don’t want to run these tests on a workbook containing the only copy of our live data! A warning MsgBox might be appropriate as a safety measure.

Finally, in a module TestRecords, we have the Run procedure. This is mixture of operations, invariant checks and post-condition checks:

Sub Run()
    TestSetup "WS Records"

    Dim rc As Integer   '(old) rowcount

    Records.Clear
    AssertEqual Records.Invariant, True
    rc = Records.RowCount
    AssertEqual rc, 1       'post Clear

    Records.AddRecord ("Abby")
    AssertEqual Records.Invariant, True
    AssertEqual Records.RowCount, rc + 1    'post AddRecord
    rc = Records.RowCount

    Records.AddRecord ("Billy")
    AssertEqual Records.Invariant, True
    AssertEqual Records.RowCount, rc + 1    'post AddRecord
    rc = Records.RowCount

    TestWrapup
End Sub

Notice that we’re calling the worksheet’s procedures via the module name “Records”. Interestingly, it still works if you call via the object – Worksheets(“Records”).Clear – but you don’t get the pop-up prompt for the properties and methods.

In some cases, we might want to clear up the worksheet after the tests have run (referred to in some frameworks as “tear down”). However, in this case it’s useful to do a visual check on what’s been added.

Now we should say something about the pre-condition on AddRecord: that Name must not be empty. The origin of this is the worksheet’s invariant: one way or antoher, we need to preserve this. AddRecord could have taken that responsibility, by doing the Length > 0 check, and using a default value. However, if there is no sensible default value, the responsibility has to be ‘pushed out’ to the client code: in this case, the ‘user interface’ procedure NewRecord. So we can’t test the pre-condition just on the worksheet, we have to involve the client code.

The problem with pre-conditions is that testing them is essentially negative: we have to show that they are never false (whereas post-conditions are shown to be true on a case-by-case basis). One approach is to make the pre-conditions executable, and evaluate them during testing or normal use. So the start of AddRecord would look like this:

Public Sub AddRecord(name As String)
    If pre Then AssertPre "Records.AddRecord", _
            (Len(name) > 0)
    ...

‘pre’ is a flag to switch this checking on or off (during development, one could leave it on all the time). We can put it in the general Test module:

Public Const pre As Boolean = True

AssertPre is just a variation on AssertEqual, which takes the procedure name as a tag:

Public Sub AssertPre(proc As String, precond As Boolean)
    Dim msg As String

    If Not precond Then
        msg = "*** Pre " & proc & " failed"
        Debug.Print (msg)
    End If
End Sub

Entering an empty value into the InputBox now causes the precondition to fail. A blank value gets put into the Name field, and the worksheet is thus invalid. Various user interface solutions are of course possible: validation, drop-down lists, etc. Here, we can just re-prompt until we get a non-empty value:

Sub NewRecord()
    Dim name As String

    Do Until Len(name) > 0
        name = InputBox("Please enter a name")
    Loop

    Records.AddRecord (name)
End Sub

NewRecord is now ensuring the pre-condition of AddRecord.

I think that’s enough for now. Next, we’ll apply these ideas to user-defined Classes (which is where the ideas came from in the first place).

Testing VBA Code – Part 2

The general idea, introduced in Part 1, is that we write at least some amount of test code, as a means of exercising our VBA projects, as opposed to (though not excluding) informal, manual use.

Out in the wider world, there is considerable use of test frameworks, such as JUnit. These are OO frameworks that define abstract classes for TestCase, TestSuite, TestResult and so on, which can be specialised for actual tests. Language ‘reflection’ is used to do things like pass method names as arguments to generic ‘run’ methods. For more information, see this JUnit overview.

We don’t need to do as much in VBA (and can’t, indeed). However, we can provide facilities to:

  • Log testing (including any failures) to a file, or maybe a worksheet, or less persistently to the Immediate window. We’ll pick the last of these for simplicity.
  • Provide ‘assertion’ procedures that check actual against expected values, and log any failure.

Incidentally, the failure of a test should be referred to as a ‘failure’, not as an ‘error’ (which means specifically a VBA environment error), or indeed ‘bug’.

The above general facilities can be put in a separate module (say, “Test”), which can be imported or included as an add-in. More on this shortly.

As to overall structure, I think we should have a test module for each primary module (that is, general modules and class modules; not forms, which we’ll ignore for now). So if I have a module Formula (containing public functions for use in Excel formulas), then I’d have a module TestFormula.

TestFormula contains a Run( ) sub:

Public Sub Run()
    TestSetup "Formula"  'the module being tested

    TestISPOSTCODE
    'test other functions in this module...

    TestWrapup
End Sub

TestSetup and TestWrapup are defined in the general Test module.

The function that we’re testing here checks for valid UK postal codes:

Function ISPOSTCODE(text As String) As Boolean
        'Is text a valid UK postcode?

    ISPOSTCODE = (text Like "[A-Z]# #[A-Z][A-Z]") Or _
            (text Like "[A-Z]## #[A-Z][A-Z]") Or _
            (text Like "[A-Z][A-Z]# #[A-Z][A-Z]") Or _
            (text Like "[A-Z][A-Z]## #[A-Z][A-Z]")
End Function

Now, it’s important that we can run all the tests in our project by a single operation, so that it can be done easily and frequently. So we need a simple TestAll sub:

Sub TestAll()
    TestFormula.Run
    'test all other modules in the project...
End Sub

This can go on its own in a TestAll module (just so that it can be found easily).

Since ISPOSTCODE is a ‘pure’ function (that is, with no side effects on the workbook),  the tests are just simple checks of the results:

Sub TestISPOSTCODE()

        'Junk values
    AssertEqual ISPOSTCODE(""), False
    AssertEqual ISPOSTCODE("12345"), False
    AssertEqual ISPOSTCODE("hello"), False

        'Valid values
    AssertEqual ISPOSTCODE("S2 3HS"), True
    AssertEqual ISPOSTCODE("B23 7UJ"), True
    AssertEqual ISPOSTCODE("CB4 6RR"), True
    AssertEqual ISPOSTCODE("PE21 4FG"), True

        'Valid but non-existent
    AssertEqual ISPOSTCODE("XX99 9XX"), True

        'Case-sensitive
    AssertEqual ISPOSTCODE("cb4 6rr"), False

        'Whitespace senstive
    AssertEqual ISPOSTCODE("S2  3HS"), False
    AssertEqual ISPOSTCODE("S23HS"), False

        'Central London - not handled yet
    AssertEqual ISPOSTCODE("WC1A 1AA"), False
    ' and so on...
End Sub

AssertEqual is defined in the general Test module (you could give it a shorter name, if you like).

This isn’t the last word in formality, but the test sub does provide quite a good at-a-glance description of what the function does (and doesn’t) do. Better than poring over the # characters.

Finally, here’s what’s in the Test module:

Dim testnum As Integer
Dim failcount As Integer
Dim activemod As String

Public Sub TestSetup(modname As String)
    activemod = modname
    testnum = 0
    failcount = 0
End Sub

Public Sub TestWrapup()
    Debug.Print (activemod & ": " & failcount & " failures")
    Debug.Print "---------"
End Sub

Public Sub AssertEqual(actual, expected)

    Dim msg As String

    testnum = testnum + 1

    If Not (actual = expected) Then
        msg = "Test " & activemod & "." & testnum _
                & " failed: actual " & actual _
                & ", expected " & expected
        Debug.Print (msg)
        failcount = failcount + 1
    End If

End Sub

This is obviously pretty basic, but it’s a start.

In the next posting, we need to consider code that alters worksheets (or other documents). Things get a bit trickier here…

Testing VBA Code – Part 1

Back from the Easter break now…

Looking at using classes got me thinking about testing again. Now, one of the reasons that VBA has a reputation for sloppy coding is that we’re often not sufficiently rigorous about testing. Even if we do exercise the code, this is often done manually in an informal manner. There’s no record of what’s been tested or how. I expect many of us have inherited old code, and had no idea to what extent it worked.

Over in the world of mainstream software development, it has been recognised that testing needs to be automated (or at least very easy to do repeatedly), and closely integrated with the coding activity. For the testing of code units, this means that tests are written as software, which exercises the primary code. In an OO language, this means that we have test classes exercising primary classes. The full current set of tests is run frequently and regularly – say overnight. There are various software frameworks, such as JUnit, for Java, which support this style of testing.

Some people advocate Test-Driven Development, in which test code is written before the primary code, possibly in very fine-grain increments: adding an individual feature or capability. In this way the tests serve as a specification for the primary code, albeit a fairly low-level one.

The ability to re-test frequently makes it much easier and safer to re-factor code: to make structural improvements that do not change behaviour. An example would be sharing some code, rather than duplicating it, at the procedure or module level. The reluctance of most people to do this kind of thing is one reason why VBA code ‘degenerates’ over time.

In general, I think this is all Good Stuff. However, applying it to VBA needs a bit of thought. In particular, our VBA code is in a quite specific context, in terms of the host application (Word, Excel, etc). This means that the software that we’re testing includes, for example, ranges and formulas defined on Excel worksheets.

Now, you might feel that you have plenty to do without writing a load of extra code – and you know it’ll work okay, don’t you? However:

  • The benefits can be considerable: you’ll probably save debugging time further down the line
  • The test code is often quite simple and stereotypical
  • It’s all part of an approach that involves thinking concretely about what your code does (and doesn’t) do.

Obviously, we’re not using VBA to build a flight-control system for the Space Shuttle (or its replacement). So there is a point at which one might say “Okay, X is just too difficult to test, I’ll settle for checking Y”.

In forthcoming posts, we’ll look at testing:

  • functions
  • procedures that interect with the document (e.g. worksheet)
  • classes.

I’ll also say something about the relationship of testing to the ideas of ‘Design by Contract’ (mentioned in an earlier posting about comments): preconditions, postconditions and invariant properties.

Worksheet vs. Custom VBA Functions

In a previous post, I mentioned experimenting with the Transpose worksheet function. Dougaj4 clarified its usage, and mentioned that it was “really slow” compared with a custom VBA function (his comment included a link to his own blog, and a downloadable workbook containing such a function). So I thought I’d check this out.

I’ve written a sub that successively transposes square arrays: 2 x 2, 3 x 3, 4 x 4, …, 256 x 256. The reason for stopping at 256 is because I initially tried this in Excel 2000 (of which more shortly). Here it is:

Sub TestTranspose()
    Dim harr As Variant
    Dim varr As Variant    'value arrays
    Dim ro As Integer
    Dim co As Integer      'row, column offsets
    Dim hrng As Range      'source range
    Dim vrng As Range      'target range

    Debug.Print Time

    ro = 1
    co = 1

    Dim i As Integer
    For i = 1 To 255
        Set hrng = Range(Range("Hstart"), _
                    Range("Hstart").Offset(ro, co))
        Set vrng = Range(Range("Vstart"), _
                    Range("Vstart").Offset(ro, co))
        harr = hrng.Value

        'Comment out one of the following
        varr = DougTranspose(harr)
        varr = WorksheetFunction.Transpose(harr)

        vrng.Value = varr

        ro = ro + 1
        co = co + 1
    Next

    Debug.Print Time
End Sub

The source ranges contain row numbers (h for horizontal), the target ranges transpose these (v for vertical).

In Excel 2000 this worked until iteration 74, when it threw Run Time Error 13: Type Mismatch. Seriously weird! Anyway it seems to work Ok in Excel 2007. And the results are … (sound of envelope being opened) …

  • WorksheetFunction: 32, 33, 32, 32 seconds
  • Doug’s VBA function: 25, 30, 31, 30 seconds

(times just to nearest second, but you get the overall idea).

So, remarkably similar. I thought the WS function would get it; Doug thought his would; end-result, pretty much the same. Now, it could be that the time taken for the other operations in the test procedure (Range and Offset) swamp the time taken for the transpose, but somehow I doubt it. Anyway, there doesn’t seem to be a prima facie case against using the worksheet function.

Using Classes – Part 4

schedule_ws2

The final step of our resource-allocation example is to provide a a form ‘view’ of our Job objects:

schedule_form

This form holds on to a ‘current’ Job object: an instance of the Job class described in Part 3. The form retrieves data from the current Job object, which in turn retrieves data from the worksheet records; the form does not access the worksheet directly. This means that the form does not need to know details of how the Job data is stored; it simply accesses the properties defined by the Job class.

UserForm_initialize creates its Job object, which initially is for a new (i.e. not yet existing) Job.

Dim myjob As Job

Private Sub UserForm_Initialize()
    Set myjob = New Job
    Display
End Sub

The Display procedure retrieves properties from the object, and sets the corresponding form controls:

Private Sub Display()
    IdText = myjob.Id
    StartText = Format(myjob.start, "dd-mmm-yy")
    FinishText = Format(myjob.finish, "dd-mmm-yy")
    ResourceText = myjob.resource
End Sub

The editable controls have AfterUpdate handlers, which update myjob. In the case of Id, there is a little validation:

Private Sub IdText_AfterUpdate()
    If IdText > 0 Then
        myjob.Id = IdText
        Display
    Else
        MsgBox ("Please enter an Id greater than zero")
        IdText = myjob.Id
    End If
End Sub

The plus and minus buttons for the dates similarly update myjob, with validation to ensure ordering:

Private Sub NextStartCommand_Click()
    If myjob.start < myjob.finish Then
        myjob.start = myjob.start + 1
        Display
    End If
End Sub

The OK button tells myjob to store itself:

Private Sub OKCommand_Click()
    If Isvalid Then
        myjob.Store
        Display
    Else
        InvalidMsg
    End If
End Sub

The validation function and the associated message are held by the object, not the form:

Private Function Isvalid() As Boolean
    Isvalid = myjob.Isvalid(IdText, StartText, _
                        FinishText, ResourceText)
End Function

Private Sub InvalidMsg()
    MsgBox "Invalid Data: please ensure that:" & vbCrLf & _
            myjob.ValidString
End Sub

This keeps the semantics in the class (okay, we cheated a bit with the plus/minus buttons; should have called myjob.IsValid).

And that’s it! The ‘smart’ resource-finding behaviour is all within the Job object, not the form. So the form is really pretty simple.

Here’s the overall structure:

schedule_design2

The objects (instances of our two classes) are created as needed, to serve as a ‘smart adapter’ layer between the form and the worksheet. In a more complex example, the objects might collate data from more than one worksheet (or even workbook). Also, we might have more than one view of a Job, or indeed of Resources.

A Zip of the workbook and the VBA modules is available here.

I’ll come back to the issue of testing classes in later posts.

Using Classes – Part 3

schedule_ws2
In Part 2, we looked at the first of our two ‘Model’ classes: Resource. This amalgamates its booking information, and can therefore answer availability queries (like keeping and looking in a diary). We now turn our attention to the second Model class: Job.

This differs from Resource in that it has a direct correspondence to records on our Bookings worksheet. So some features of the class are to do with its persistence: getting data off and back on to the worksheet. Getting data for a Job off the worksheet will be done using the VLOOKUP function. Writing data to the worksheet just involves setting Range.Value.

The key feature of Job is AcquireResource: this creates a Resource object for each available resource, in turn, and queries its availability, stopping when it gets a positive response. This makes the ordering of resources (in a list on another worksheet) significant: a later available resource will only get allocated if all earlier resources are unavailable. This minimises the number of resources used, which is what we want (a more balanced allocation strategy is possible).

So to the code. Internally (privately) we hold the attributes of the Job:

Dim jid As Integer
Dim jstart As Date
Dim jfinish As Date
Dim jresource As String

The invariant is slightly tricky in that a Job is valid (for purposes of storing on the worksheet) only if it has an allocated resource. However, it’s possible that a Job ‘in preparation’ might not (yet) have a resource, and we have to allow for this. Rather inelegantly, we’ll just use a placeholder value “none”.

Public Function Invariant() As Boolean
    Invariant = Isvalid(jid, jstart, jfinish, jresource) Or _
                Isvalid(jid, jstart, jfinish, "none")

End Function

Public Function Isvalid(Id As Integer, start As Date, _
             finish As Date, resource As String) As Boolean
    Isvalid = Id > 0 And (start <= finish) And _
                                Len(resource) > 0

End Function

Now for the Class_initialize handler. This needs to increment the current maximum Job Id. If there are no Jobs at all, we need to handle the error thrown by an empty dynamic range (see Part 2).

Public Sub Class_initialize()
    'post: (jid > 0) and (jstart = jfinish)

    Dim maxid As Integer

    On Error Resume Next    'Dynamic ranges not found if empty
    maxid = WorksheetFunction.Max(Range("Jobs"))

    jid = maxid + 1     'On error, maxid = 0
    jstart = Date
    jfinish = Date
    AcquireResource

End Sub

Notice that the object attempts to AcquireResource; this might succeed or fail. So we don’t store the Job immediately; this is done by a client object (in this case our Form).

The four attributes (see earlier) each have a standard Get procedure. start and finish have standard Let procedures. resource has no Let procedure; it is set only by AcquireResource. Id has a Let procedure which (like the Resource class) targets the object to an existing Job, or re-initializes the object:

Property Let Id(newid As Integer)
        'Target Job at a given Id, retrieving data fields
        'Re-initialize by giving a nonexistent Id (e.g. 99)
        'pre: newid > 0

    Dim lookupid As Integer
    Dim maxid As Integer

    On Error GoTo NoJobs    'Dynamic ranges not found if empty
    lookupid = WorksheetFunction.Lookup(newid, Range("Jobs"))

    If lookupid = newid Then 'newid found
        jid = newid
        Retrieve

    Else 'newid not found - initialize new Job
        Call Class_initialize
    End If

    Exit Property
NoJobs:
        Call Class_initialize

End Property

For an existing Job, we need to retrieve the data from the worksheet. This is just a bunch of VLOOKUPs:

Private Sub Retrieve()
    jstart = WorksheetFunction.VLookup(jid, _
                Range("Bookings"), 2, False)
    jfinish = WorksheetFunction.VLookup(jid, _
                Range("Bookings"), 3, False)
    jresource = WorksheetFunction.VLookup(jid, _
                Range("Bookings"), 4, False)
End Sub

The other side of the persistence is storing the object. There are several different cases: first ever Job, existing Job, subsequent new Job:

Public Sub Store()

    Dim rownum As Integer

    If jid > 1 Then 'Not first Job
        rownum = WorksheetFunction.Match(jid, Range("Jobs")) _
                + Range("Job").Row       'Allow for header row

        If rownum <> jid + Range("Job").Row Then
                                'new Job; append to data rows
            rownum = rownum + 1
            Range("Job " & rownum & ":" & rownum).Value = jid
        End If
    Else ' First Job
        rownum = Range("Job").Row + 1       'First data row
        Range("Job " & rownum & ":" & rownum).Value = jid
    End If

    Range("Start " & rownum & ":" & rownum).Value = jstart
    Range("Finish " & rownum & ":" & rownum).Value = jfinish
    Range("Resource " & rownum & ":" & rownum).Value = jresource
            'Ranges Start, etc, are whole-columns

End Sub

I expect that there are different ways of doing this. Here I’m using the MATCH function. In the Range.Value assignments, I’m intersecting a named whole-column range with the appropriate whole-row range:
Range(“SomeColumn R:R”).

Finally, we have AcquireResource, which creates Resource objects, and queries their availability. There is a simple list of resource Ids in the range “Resources”, on another worksheet.

Private Sub AcquireResource()
    'pre: Range("Resources").Count > 0
    Dim resid As String
    Dim res As resource

    jresource = ""

    Dim i As Integer
    For i = 1 To Range("Resources").Count
        resid = WorksheetFunction.Index( _
                                    Range("Resources"), i, 1)
        Set res = New resource
        res.Id = resid
        If res.IsAvailable(jstart, jfinish) Then
            jresource = resid
            Exit For
        End If
    Next

End Sub

Note the precondition (which you can check in the Immediate window); this means that the procedure does not need to handle the empty-range error case, in contrast to other procedures.

The final stage is to provide a View of our Job objects: in other words a UserForm that displays and allows a user to set properties of a Job. Coming shortly…


April 2009
M T W T F S S
« Mar   May »
 12345
6789101112
13141516171819
20212223242526
27282930  

Follow

Get every new post delivered to your Inbox.