2

I am working with sets of timesheet data - where people record their time against clients and they give a free text narrative to describe the work they did.

When it comes to billing for the time, a report is produced which has many lines of data, each line containing things like hours, employee and the narrative they wrote. When billing for the time, similar lines of time need to be grouped together into a standard description which the client understands. So a key task of this work is to assign Billing Categories to the lines to group like lines together, and then report on them.

I have build an Excel tool to help with all sorts of aspects of this work, but a major enhancement I am working on is for the tool to build itself a referential 'database' of Narratives and Billing Categories. It will then use this referencing to predict the Billing Category that could be assigned to new lines of timeline data in future, saving the person doing the billing a lot of time assigning the standard Billing Categories themselves.

So to do this, I thought it best to create a class object called 'Narrative' with properties which store the info I need - such as Billing Category, frequency of matches etc. I am then reading in historic data of previous assignments of Billing Categories to Narratives and storing those items in Objects which are collected together in a dictionary object.

I have decided on this approach because the use of a dictionary is convenient because of things like the ability to check if a Narrative already exists - if it does then the new instance being read in does not get added to the dictionary.

This works OK, but I want to be able to output the items stored within the Narrative Objects held in the Dictionary to a worksheet range. Below is the code I use for this :

Sub OutputDict()

Dim counter As Long
counter = 1

Dim strKey

For Each strKey In dict_Narratives.Keys()

Worksheets("Output").Range("A" & counter).Value = dict_Narratives.Item(strKey).Narrative
Worksheets("Output").Range("B" & counter).Value =     dict_Narratives.Item(strKey).BillCat
Worksheets("Output").Range("C" & counter).Value =     dict_Narratives.Item(strKey).DateIndex
Worksheets("Output").Range("D" & counter).Value =     dict_Narratives.Item(strKey).Frequency
counter = counter + 1

Next

End Sub

This code works, but unfortunately takes a stupid amount of time to output the data! Is there a more efficient way to do this - perhaps putting the dictionary of data into an array object or something, and then dumping the array out in bulk to a defined range? Maybe this could work faster because it isn't iterating cell by cell like my code above is doing? I have no idea how to get the object properties within the dictionary into an array though. Any help much appreciated!

EDIT - HERE IS THE ANSWER...

I didn't have much luck looking at the page that was linked to where apparently there was a duplicate of my question, but having read around I have sussed out a solution. I needed to loop through my dictionary and add the items to arrays. Then spitting them out to a range on a worksheet. This is infinitely quicker than looping through cells for doing the outputs. My code for doing this is :

Sub KeysToSpreadSheet()

Dim strKey
Dim vArrNarrative As Variant
Dim vArrBillCat As Variant
Dim vArrDateIndex As Variant
Dim vArrFrequency As Variant


ReDim vArrNarrative(1 To 1) As String
ReDim vArrBillCat(1 To 1) As String
ReDim vArrDateIndex(1 To 1) As String
ReDim vArrFrequency(1 To 1) As String


For Each strKey In dict_Narratives.Keys()

vArrNarrative(UBound(vArrNarrative)) = dict_Narratives(strKey).Narrative
ReDim Preserve vArrNarrative(1 To UBound(vArrNarrative) + 1) As String

vArrBillCat(UBound(vArrBillCat)) = dict_Narratives(strKey).BillCat
ReDim Preserve vArrBillCat(1 To UBound(vArrBillCat) + 1) As String

vArrDateIndex(UBound(vArrDateIndex)) = dict_Narratives(strKey).DateIndex
ReDim Preserve vArrDateIndex(1 To UBound(vArrDateIndex) + 1) As String

vArrFrequency(UBound(vArrFrequency)) = dict_Narratives(strKey).Frequency
ReDim Preserve vArrFrequency(1 To UBound(vArrFrequency) + 1) As String

Next

Sheets("Sheet1").Range("B2:B" & UBound(vArrNarrative) - 1) = Application.Transpose(vArrNarrative)
Sheets("Sheet1").Range("C2:C" & UBound(vArrBillCat) - 1) = Application.Transpose(vArrBillCat)
Sheets("Sheet1").Range("D2:D" & UBound(vArrDateIndex) - 1) =     Application.Transpose(vArrDateIndex)
Sheets("Sheet1").Range("E2:E" & UBound(vArrFrequency) - 1) =     Application.Transpose(vArrFrequency)

End Sub
Greg
  • 21
  • 3

0 Answers0