Data-collection in Excel-VBA using nested dictionaries

Question

Introduction

I have a spreadsheet in Excel, looking like this: I collect and sort the values in the column labelled "Antal dagar venting", based on the values in the columns "Nivå 1" and "Nivå 2".

My current code for collecting this data is:

In a class-module:

Option Explicit

Private pAntalDagar As Long
Private pDelårsaker As Dictionary

' Tid
Public Property Get AntalDagar() As Long
    AntalDagar = pAntalDagar
End Property
Public Property Let AntalDagar(Value As Long)
    pAntalDagar = Value
End Property

' Delårsaker
Public Property Get Delårsaker() As Dictionary
    Set Delårsaker = pDelårsaker
End Property
Public Property Set Delårsaker(Value As Dictionary)
    Set pDelårsaker = Value
End Property

In a regular module:

Option Explicit

Sub samle_data(fra As Date, til As Date)
    Dim c As Range
    Dim tid As Long
    Dim hovudårsak As String, delårsak As String, feil_melding As String
    Dim v As Variant
    Dim hovudårsaker As clsHovudårsak
    Dim dictHovudårsaker As Dictionary, dictDelårsaker As Dictionary, dictManglandeVerdier As Dictionary

    Set hovudårsaker = New clsHovudårsak
    Set dictHovudårsaker = New Dictionary: Set dictManglandeVerdier = New Dictionary

    For Each c In Range(Registrering.Range("A3"), Registrering.Range("A1048576").End(xlUp))
        If IsNumeric(c.Offset(0, 6).Value2) Then
            tid = CLng(c.Offset(0, 6).Value2)
        Else
            tid = 0
        End If
        If tid < 0 Then
            feil_melding = "Ventetida er mindre enn null dagar"
            dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
        ElseIf Len(c.Offset(0, 1).Value2) = 0 Then
            feil_melding = "Det manglar hovudårsak"
            dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
        ElseIf Len(c.Offset(0, 2).Value2) = 0 Then
            feil_melding = "Det manglar delårsak"
            dictManglandeVerdier.Add Item:=feil_melding, Key:=c.Offset(0, 6).AddressLocal
        ElseIf Len(c.Offset(0, 5).Value2) <> 0 Then
            hovudårsak = CStr(c.Offset(0, 1).Value2)
            delårsak = CStr(c.Offset(0, 2).Value2)
            If dictHovudårsaker.Exists(hovudårsak) Then
                Set hovudårsaker = dictHovudårsaker(hovudårsak)
                hovudårsaker.AntalDagar = hovudårsaker.AntalDagar + tid
                Set dictDelårsaker = hovudårsaker.Delårsaker
                If dictDelårsaker.Exists(delårsak) Then
                    dictDelårsaker(delårsak) = dictDelårsaker(delårsak) + tid
                Else
                    dictDelårsaker.Add Item:=tid, Key:=delårsak
                    hovudårsaker.AntalDagar = tid
                    Set hovudårsaker.Delårsaker = dictDelårsaker
                End If
            Else
                Set hovudårsaker = New clsHovudårsak
                Set dictDelårsaker = New Dictionary
                hovudårsaker.AntalDagar = tid
                Set hovudårsaker.Delårsaker = dictDelårsaker
                dictDelårsaker.Add Key:=delårsak, Item:=tid
                dictHovudårsaker.Add Key:=hovudårsak, Item:=hovudårsaker
            End If
        End If
    Next c

    For Each v In dictManglandeVerdier
        feil_melding = CStr(dictManglandeVerdier(v)) & " i celle " & CStr(v) & " i registreringsarket." & vbCrLf _
                                    & vbCrLf & "Data frå denne linja vil ikkje verte teke med i grafane."
        MsgBox Prompt:=feil_melding, Buttons:=vbExclamation, Title:="Mangler data"
    Next v

    Call skriv_data(dictHovudårsaker)
End Sub

Sub skriv_data(dictHovudårsaker As Dictionary)
    Dim hovudårsak As Variant, delårsak As Variant
    Dim hovudårsaker As clsHovudårsak
    Dim dictDelårsaker As Dictionary

    For Each hovudårsak In dictHovudårsaker
        Set hovudårsaker = dictHovudårsaker(hovudårsak)
        Set dictDelårsaker = hovudårsaker.Delårsaker
        'Debug.Print "Hovudårsak: " & hovudårsak & " - Tid: " & hovudårsaker.AntalDagar
        For Each delårsak In dictDelårsaker
            'Debug.Print "Delårsak: " & delårsak & " - Tid: " & dictDelårsaker(delårsak)
        Next delårsak
    Next hovudårsak
End Sub

Sub test()
    Call samle_data(#1/1/2010#, #12/31/2015#)
End Sub

The problem

I think the loop described in the procedure skriv_data shows the output I want pretty well. The output for the sample workbook I posted at the top would be something like this:

Now, I believe the code works as it should, or at least I haven't found any bugs in it yet. However I feel it is rather convoluted, so I was wondering if someone here has any suggestions for how I can improve it? I'd like to avoid using Pivot-tables.

Answer 1

Len(rng.Value2) = 0 is not as efficient as IsEmpty(rng). Not sure if that function is the same in every language. See https://stackoverflow.com/questions/13360651/excel-how-to-check-if-a-cell-is-empty-with-vba

I don't think any of your CStr are necessary.

It is confusing to have variables with similar names -- hovudårsak and hovudårsaker for instance.

Why did you make it a class module with properties? It doesn't seem to benefit at all by that design choice over a Type.