2
\$\begingroup\$

Background

I have a vba solution that I use to ingest investment text reports and reformat them for analysis in Excel. It works, but the macros involve a lot of direct manipulation of Excel objects, and have no unit-testing.

After finding RubberDuck, and reading several years' worth of excellent posts from @MathieuGuindon, I've decided to re-write the "brute force"-heavy solution as a way to learn these new concepts and techniques.

When ingesting from a report, I also pull additional attributes from excel tables. I'm beginning my re-write with those lookup tables. The first of which I'm submitting here.

Initial goals:

  • Programming to Interfaces not classes
  • Making Services and Proxies rather than direct access to Excel sheets and ranges
  • Using the PredeclaredId attribute to enable a Create method
  • Thorough unit testing

Apart from general review, I also have some specific questions, which I'll post following the code.


Code

IAssetTableProxy -- abstracts reference to the "physical" excel table's data rows

'@Folder("Services.Interfaces")
Option Explicit

Public Function GetAssetTableData() As Variant()
End Function

AssetTableProxy -- Implementation

'@Folder("Services.Proxies")
Option Explicit
Implements IAssetTableProxy

Public Function IAssetTableProxy_GetAssetTableData() As Variant()

    Dim tblName As String
    tblName = "AssetInfoTable"

    IAssetTableProxy_GetAssetTableData = Worksheets(Range(tblName).Parent.Name).ListObjects(tblName).DataBodyRange.value

End Function

AssetInfo -- a class to handle the three values for each row: Desc, Ticker, Type

'@PredeclaredId
'@Folder("Services")
Option Explicit

Private Type TAssetInfo
    Desc As String
    Ticker As String
    AssetType As String
End Type
Private this As TAssetInfo

Public Property Get Desc() As String
    Desc = this.Desc
End Property

Friend Property Let Desc(ByVal value As String)
    this.Desc = value
End Property

Public Property Get Ticker() As String
    Ticker = this.Ticker
End Property

Friend Property Let Ticker(ByVal value As String)
    this.Ticker = value
End Property

Public Property Get AssetType() As String
    AssetType = this.AssetType
End Property

Friend Property Let AssetType(ByVal value As String)
    this.AssetType = value
End Property

Public Property Get Self() As AssetInfo
    Set Self = Me
End Property

Public Function Create(ByVal theDesc As String, ByVal theTicker As String, ByVal theAssetType As String) As AssetInfo

    With New AssetInfo

        .Desc = theDesc
        .Ticker = theTicker
        .AssetType = theAssetType

        Set Create = .Self 

    End With

End Function

IAssetInfoService -- holds a collection of AssetInfo objects and provides the needed lookups to data from AssetTableProxy

'@Folder("Services.Interfaces")
Option Explicit

Public Function Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService
End Function

Public Function GetAssetTypeForDesc(ByVal Desc As String) As String
End Function

Public Function GetTickerForDesc(ByVal Desc As String) As String
End Function

AssetInfoService -- implementation

'@PredeclaredId
'@Folder("Services")
Option Explicit
Option Base 1
Implements IAssetInfoService

Private Type TAssetsTable
    AssetColl As Collection
End Type
Private this As TAssetsTable

Friend Property Get Assets() As Collection
    Set Assets = this.AssetColl
End Property

Friend Property Set Assets(ByRef coll As Collection)
    Set this.AssetColl = coll
End Property

Public Property Get Self() As IAssetInfoService
    Set Self = Me
End Property

Public Function IAssetInfoService_Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService

    Dim twoDArr() As Variant

    twoDArr = assetTbl.GetAssetTableData

    With New AssetInfoService

        Dim tempAsset As AssetInfo

        Dim tempColl As Collection
        Set tempColl = New Collection

        Dim rw As Long
        For rw = 1 To UBound(twoDArr, 1)
            Set tempAsset = AssetInfo.Create(twoDArr(rw, 1), twoDArr(rw, 2), twoDArr(rw, 3))

            tempColl.Add tempAsset, key:=tempAsset.Desc
        Next rw

        Set .Assets = tempColl

        Set IAssetInfoService_Create = .Self 

    End With

End Function


Public Function IAssetInfoService_GetAssetTypeForDesc(ByVal Desc As String) As String

    Dim tempTp As String
    If Exists(this.AssetColl, Desc) Then
        tempTp = this.AssetColl(Desc).AssetType
    Else
        tempTp = "Unknown Asset"
    End If
    IAssetInfoService_GetAssetTypeForDesc = tempTp

End Function

Public Function IAssetInfoService_GetTickerForDesc(ByVal Desc As String) As String

    Dim tempTicker As String
    If Exists(this.AssetColl, Desc) Then
        tempTicker = this.AssetColl(Desc).Ticker
    Else
        tempTicker = "Unknown Asset"
    End If
    IAssetInfoService_GetTickerForDesc = tempTicker

End Function

Private Function Exists(ByRef coll As Collection, ByRef key As String) As Boolean

    On Error GoTo ErrHandler

    coll.Item key

    Exists = True
ErrHandler:
End Function

Unit Testing

AssetTableTestProxy -- proxy implementation for testing w/o dependency on actual excel table

'@Folder("Services.Proxies")
Option Explicit
Option Base 1
Implements IAssetTableProxy

Public Function IAssetTableProxy_GetAssetTableData() As Variant()

    Dim twoDArr(1 To 3, 1 To 3) As Variant

    twoDArr(1, 1) = "Asset1"
    twoDArr(1, 2) = "Tick1"
    twoDArr(1, 3) = "Type1"

    twoDArr(2, 1) = "Asset2"
    twoDArr(2, 2) = "Tick2"
    twoDArr(2, 3) = "Type2"

    twoDArr(3, 1) = "Asset3"
    twoDArr(3, 2) = "Tick3"
    twoDArr(3, 3) = "Type3"

    IAssetTableProxy_GetAssetTableData = twoDArr

End Function

TestAssetInfoService -- Unit tests for Asset Info Service

Option Explicit
Option Private Module
'@TestModule
'@Folder("Tests")

Private Assert As Object
Private Fakes As Object
Private assetTbl As IAssetTableProxy

'@ModuleInitialize
Public Sub ModuleInitialize()
    'this method runs once per module.
    Set Assert = CreateObject("Rubberduck.AssertClass")
    Set Fakes = CreateObject("Rubberduck.FakesProvider")
    Set assetTbl = New AssetTableTestProxy
End Sub

'@ModuleCleanup
Public Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
    Set Fakes = Nothing
    Set assetTbl = Nothing
End Sub

'@TestInitialize
Public Sub TestInitialize()
    'this method runs before every test in the module.
End Sub

'@TestCleanup
Public Sub TestCleanup()
    'this method runs after every test in the module.
End Sub

'@TestMethod
Public Sub GivenAssetInTable_GetTicker()
    On Error GoTo TestFail

    'Arrange:
    Dim tbl As IAssetInfoService
    Set tbl = AssetInfoService.IAssetInfoService_Create(assetTbl)

    'Act:
    Dim tick As String
    tick = tbl.GetTickerForDesc("Asset2")

    'Assert:
    Assert.AreEqual "Tick2", tick, "Tick was: " & tick

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub GivenAssetInTable_GetAssetType()
    On Error GoTo TestFail

    'Arrange:
    Dim tbl As IAssetInfoService
    Set tbl = AssetInfoService.IAssetInfoService_Create(assetTbl)

    'Act:
    Dim assetTp As String
    assetTp = tbl.GetAssetTypeForDesc("Asset2")


    'Assert:
    Assert.AreEqual "Type2", assetTp, "AssetTp was: " & assetTp

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

'@TestMethod
Public Sub GivenAssetNotInTable_GetUnknownAssetMsg()
    On Error GoTo TestFail

    'Arrange:
    Dim tbl As IAssetInfoService
    Set tbl = AssetInfoService.IAssetInfoService_Create(assetTbl)

    'Act:
    Dim tp As String
    tp = tbl.GetAssetTypeForDesc("unsub")

    'Assert:
    Assert.AreEqual "Unknown Asset", tp

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

Module1 -- additional sub to play around with functions

Option Explicit

Sub TestAssetInfoTable()

    Dim assetTbl As IAssetTableProxy
    Dim testAssetTbl As AssetTableTestProxy

    Set assetTbl = New AssetTableProxy
    Set testAssetTbl = New AssetTableTestProxy

    Dim assetSvc As IAssetInfoService
    Dim testAssetSvc As IAssetInfoService

    Set assetSvc = AssetInfoService.IAssetInfoService_Create(assetTbl)
    Set testAssetSvc = AssetInfoService.IAssetInfoService_Create(testAssetTbl)

    Dim tp As String
    Dim tick As String

    tp = assetSvc.GetAssetTypeForDesc("AMAZON COM INC (AMZN)")
    tick = assetSvc.GetTickerForDesc("AMAZON COM INC (AMZN)")

    MsgBox ("Real Svc: tp=" & tp & "; tick=" & tick)

    tp = testAssetSvc.GetAssetTypeForDesc("Asset3")
    tick = testAssetSvc.GetTickerForDesc("Asset3")

    MsgBox ("Test Svc: tp=" & tp & "; tick=" & tick)


End Sub

Specific questions:

  1. I initially had the "proxy" logic in the service class. But it felt like I was duplicating too many functions when I created the AssetInfoTestService class. Breaking it out to AssetTableProxy and AssetTableTestProxy allowed me to keep only one version of the service functions. But is this carrying things (abstraction?) too far?
  2. Learning about interfaces, I believe I understand the following pieces:

    • the contract created by each Function mentioned in the interface;
    • the requisite coding of corresponding Interface_Function in the implementing class;
    • the dimm-ing of class var "as Interface"; and
    • accessing the functions with classVar.Function
      • However there seems to be an exception here. In TestAssetInfoTable I dim assetSvc as IAssetInfoService. That interface has a Create function, and in the concrete class, I have IAssetInfoService_Create defined. But when I try to call AssetInfoService.Create(…) I get a compile error that only clears when I change to AssetInfoService.IAssetInfoService_Create. What am I missing there?
  3. I see the "Option Base 1" thing. Since leave C pointers long ago, I haven't really had a religious belief one way or the other on 0- vs 1-based arrays. I went with it here, because when I began playing with the (extremely handy) multiDimArray = Range I noted the returned arrays are 1-based. And I kept screwing myself up between coding for those, and coding for my own 0-based ones. So I just opted to go all 1-based. Rubberduck Code Inspections do always throw that decision back in my face though, so let me ask here: are compelling reasons to not do that, or work arounds/tips for the multiDimArray = Range 1-based thing?

\$\endgroup\$
3
\$\begingroup\$

First off, nice work overall. It's apparent from the way you set up your interfaces and implementations that you "get it". Given that, most? of this can probably be classified as "nitpicking". I'm also not going to specifically address your second question, but the answers should be apparent based on the review itself (if not, feel free to ask in the comments). I'm completely ambivalent as to your 1st question (and can't really compare them without seeing the alternative structure), although others may have opinions there.


AssetInfoService's internal Collection is not properly encapsulated. You expose it like this...

Friend Property Get Assets() As Collection
    Set Assets = this.AssetColl
End Property 

...but that is relying on the caller to hold a reference to its interface instead of a hard reference to prevent a call like AssetInfoService.Assets.Remove or AssetInfoService.Assets.Add from anywhere in the same project. The Friend modifier obviously prevents other projects from doing this, but it isn't clear from the code provided why you would want a caller to be able to mess with the internals of the class like that. If the intention of the IAssetInfoService is to wrap a Collection (as evidenced by the Exists method), then I'd provide a complete wrapper.


Related to the above, I'd say it's overkill to provide an internal Type that contains a single member:

Private Type TAssetsTable
    AssetColl As Collection
End Type
Private this As TAssetsTable

Nitpick, but I'd also prefer an empty line after End Type - that makes it more readable.


The factory Create methods are much, much clearer in the calling code if you implement them on the base class also. That's why you have to write code like this:

Set assetSvc = AssetInfoService.IAssetInfoService_Create(assetTbl)
Set testAssetSvc = AssetInfoService.IAssetInfoService_Create(testAssetTbl)

The best way to think of a class's implementation is the same way that it would be viewed in a COM TypeLib - internally, AssetInfoService is more or less treated as an implicit interface (let's call it _AssetInfoService to follow MS convention). Unlike .NET, the implemented interfaces are not aggregated back into the "base" interface implicitly - that's why you need to use the explicit interface version when you have an instance of the concrete class. If the intention is to have the procedure accessible from the implementing class, the standard way of doing this in VBA is to wrap the base method with the interface's implementation:

Public Function Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService
    Dim twoDArr() As Variant

    twoDArr = assetTbl.GetAssetTableData

    With New AssetInfoService

    '... etc.
End Function

Public Function IAssetInfoService_Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService
    Set IAssetInfoService_Create = Me.Create(assetTbl)
End Function

That makes the calling code much more readable:

Set assetSvc = AssetInfoService.Create(assetTbl)
Set testAssetSvc = AssetInfoService.Create(testAssetTbl)

I don't see a reason for the Self properties of your factories to be public. If you're only intending to provide access to them via their interfaces, there isn't a reason to expose this on the concrete instances. The reason for this is that there is no restriction on "up-casting". This is perfectly legal:

Sub Foo()
    Dim bar As IAssetInfoService
    Set assetSvc = AssetInfoService.IAssetInfoService_Create(assetTbl)

    Dim upCast As AssetInfoService
    Set upCast = assetSvc
    With upCast.Self
        'Uhhhh...
    End With
End Sub

The other side of this is related to the discussion of the "base" interface above. If for some reason a caller up-casts to AssetTableProxy, they'll find that it has no public members...


AssetTableProxy has what I would consider to be a bug. This code is implicitly using the ActiveWorkbook and the ActiveSheet:

Public Function IAssetTableProxy_GetAssetTableData() As Variant()

    Dim tblName As String
    tblName = "AssetInfoTable"

    IAssetTableProxy_GetAssetTableData = Worksheets(Range(tblName).Parent.Name).ListObjects(tblName).DataBodyRange.value

End Function

If this is always supposed to reference the current workbook, I'd use ThisWorkbook.Worksheets (or the equivalent code name). The unqualified Range will throw if the ActiveSheet isn't a Worksheet, so your method of finding the ListObject this way puts you in kind of a catch 22 because you're only using the name of the table, which means that you need to get its parent worksheet to find... its worksheet? Just skip all of this and use the code name of the sheet directly. Also, tblName is functionally a constant. I'd declare it as one.

Private Const TABLE_NAME As String = "AssetInfoTable"

Public Function IAssetTableProxy_GetAssetTableData() As Variant()
    'Replace Sheet1 with the actual code name of the worksheet.
    IAssetTableProxy_GetAssetTableData = Sheet1.ListObjects(TABLE_NAME).DataBodyRange.value
End Function

Nitpick - I would remove the underscores in your test names (i.e. GivenAssetInTable_GetTicker()). The underscore has special meaning in VBA for procedure names - it's treated as kind of an "interface or event delimiter". This is probably our fault (as in Rubberduck's - I'm a project contributor) in that the "Add test module with stubs" used to do this when it was naming tests. This has been corrected in the current build, and TBH I'd like to see an inspection for use of an underscore in a procedure name that isn't an interface member or event handler (but I digress). The main take-away here is that when you see an underscore in a procedure name, you shouldn't need to ask yourself if it has meaning outside the name.


Another nitpick - there's no reason to Set assetTbl = Nothing in ModuleCleanup(). The reason that the Assert and Fakes are explicitly set to Nothing has to do with the internal architecture of Rubberduck's testing engine. In your case it doesn't matter in the least if the reference to your IAssetTableProxy isn't immediately freed.


Specifically regarding your third question. The reason Rubberduck suggests not using Option Base 1 is that it is a per module option that overrides the default array base of the language. If you specify the lower bound like you do here...

Option Explicit
Option Base 1
Implements IAssetTableProxy

Public Function IAssetTableProxy_GetAssetTableData() As Variant()

    Dim twoDArr(1 To 3, 1 To 3) As Variant

    '...

    IAssetTableProxy_GetAssetTableData = twoDArr

End Function

...it is superfluous - you're always creating an array with base 1 and doing it explicitly. You should be doing this anyway if you're using a non-zero base because it's clear that the lower bound is "non-standard" without requiring the person looking at the code to scroll all the way to the top of the module and catch the fact that you have a non-standard option defined. I can see it at the point of the declaration.

The other place it appears is in AssetInfoService, but it is completely unneeded there also. The only place you are assigning an array is here...

Dim twoDArr() As Variant

twoDArr = assetTbl.GetAssetTableData

...and that module doesn't control the actual creation of the array. You can remove Option Base 1 everywhere in your code and it will have no effect what-so-ever.

If you're using arrays from an external source (i.e. Excel), you should be using LBound anyway - VBA has a zero default, but a COM SAFEARRAY allows the lower bound to be an arbitrary number. Pedantically, this code...

 For rw = 1 To UBound(twoDArr, 1) 

...should be:

For rw = LBound(twoDArr, 1) To UBound(twoDArr, 1) 

That decouples your interface from the representation of the array that is supplied by the IAssetTableProxy. This is just like any other form of coupling in that it makes the implementation "brittle" to the extent that it makes assumptions about the form of the data.

\$\endgroup\$
  • \$\begingroup\$ Out of interest, what would you suggest for the names of test methods? I noticed Mathieu Guindon's battleship tests use the same convention: TestName_ExpectedReturnValueand I was quite taken with it, as it conveys a lot of useful information about the test in a readable fashion. Given that the battleship project is sort of a Rubberduck showcase (IIUC), it would be good to have everyone on the same page; what do you think is a good general format for these tests? Just remove the underscore and leave as is? \$\endgroup\$ – Greedo Mar 3 at 18:39
  • \$\begingroup\$ @Greedo I'd just omit the underscore: TestNameExpectedReturnValue. In cases where I had a ton of identical TestName's, I'd organize that into a module and/or make that the test category instead. \$\endgroup\$ – Comintern Mar 3 at 19:05
  • \$\begingroup\$ Thanks @Comintern. Yes, oops, the coll exposure in AssetInfoService doesn't belong. (It's a relic of me figuring things out.) \$\endgroup\$ – jdap Mar 4 at 21:09
  • \$\begingroup\$ LBound tip is great. Consistent use of that will likely remove the times I was tripping myself up with 1 v 0. \$\endgroup\$ – jdap Mar 4 at 21:10
  • \$\begingroup\$ I didn't completely follow the analogy on the interfaces (not really conversant in .NET), but I agree that things are much more readable with the structure you recommend. That gets around the awkward difference/compile error I found in calling implementations of Ixxx_Create versus implementations of all other Ixxx_Functions. (still not sure why it's that way). \$\endgroup\$ – jdap Mar 4 at 21:11
1
\$\begingroup\$

@comintern, I've implemented most of the rest of your suggestions. Much more readable! Details and revised code below.

  • Refactored to Base 0 (including the hardcoded twoDArr in AssetTableTestProxy) and using LBound
  • Removed Property Get/Set Assets
  • Refactored to Property Let AddAsset
  • Refactored IAssetInfoService_Create as suggested

Couple points I'm unsure about:

  • AddAsset: Q) Is there a better way/place to instantiate this.AssetColl? I tried a few other solutions, but could not get things to work.
  • Create: Q) The syntax of .AddAsset = ... feels off. The equal sign bothers me as this is not really an assignment operation. Is there a better way to use this property?
  • I still struggle a bit with the scoping(?). The working of the PredeclaredId and the, kind of call-within-a-call nature of the With New <object of class I'm already in> ... End With structure takes some thinking. I'm betting that's what's screwing with me on the instantiation of AssetCol. And I'm also certain that's why I have to use Friend instead of Private, though I'm unable to articulate the reason.

AssetInfoService.cls

'@PredeclaredId
'@Folder("Services")
Option Explicit
Implements IAssetInfoService

Private Type TAssetsTable
    AssetColl As Collection
End Type
Private this As TAssetsTable

Friend Property Get Self() As IAssetInfoService
    Set Self = Me
End Property

Friend Property Let AddAsset(ByRef theAsset As AssetInfo)
    If this.AssetColl Is Nothing Then
        Set this.AssetColl = New Collection
    End If
    this.AssetColl.Add theAsset, key:=theAsset.Desc
End Property

Public Function IAssetInfoService_Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService
    Set IAssetInfoService_Create = Me.Create(assetTbl)
End Function

Friend Function Create(ByRef assetTbl As IAssetTableProxy) As IAssetInfoService

    Dim twoDArr() As Variant

    twoDArr = assetTbl.GetAssetTableData

    With New AssetInfoService

        Dim arrBase As Long
        arrBase = LBound(twoDArr) ' need to allow for 0-based in testing, but 1-based when arr populated from Excel range

        Dim row As Long
        For row = LBound(twoDArr) To UBound(twoDArr)
            .AddAsset = AssetInfo.Create(twoDArr(row, arrBase), twoDArr(row, arrBase + 1), twoDArr(row, arrBase + 2))
        Next row

        Set Create = .Self

    End With

End Function


Public Function IAssetInfoService_GetAssetTypeForDesc(ByVal Desc As String) As String

    Dim tempTp As String
    If Exists(this.AssetColl, Desc) Then
        tempTp = this.AssetColl(Desc).AssetType
    Else
        tempTp = "Unknown Asset"
    End If
    IAssetInfoService_GetAssetTypeForDesc = tempTp

End Function

Public Function IAssetInfoService_GetTickerForDesc(ByVal Desc As String) As String

    Dim tempTicker As String
    If Exists(this.AssetColl, Desc) Then
        tempTicker = this.AssetColl(Desc).Ticker
    Else
        tempTicker = "Unknown Asset"
    End If
    IAssetInfoService_GetTickerForDesc = tempTicker

End Function

Private Function Exists(ByRef coll As Collection, ByRef key As String) As Boolean

    On Error GoTo ErrHandler

    coll.Item key

    Exists = True
ErrHandler:
End Function
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.