List(Of ) like operation in macro

NOTE: I previously asked this question in Stack Overflow and got pointed here.

I have a macro that I am trying to get running a little more quickly. The intent of the macro is to merge multiple files into one. These files contain a unique ID for each item, some descriptive information about the item, and some measurement outcomes for each item. The measurement outcomes are what differ between the files.

In all the files, each item occupies a row, with the measurements in columns. No file lists all the items, but some items do appear in more than one file.

Currently, I iterate through the files and either use the data to update an existing row (for the items in a file that's already been processed), or create a new row if the item hasn't appeared in any previous file.

The place I'm losing a good chunk of time, especially on the later files, is finding the row for an item I've already added to the unified list, so that I can add the new measurement values to the appropriate column(s).

Public OldOName As String
Public INotFnd As String
Public FErr As String

Function MMFProcessor(sfol As String, ifn As String, x As Integer, os As Worksheet, NPU As String, Prods As String, sw As StatWin, PM As String, _
FlgMeas() As String, m As Long, MKO As String, OName As String, Optional Ambetter As Boolean = False) As Variant()
'
Dim src As Workbook
Set src = Workbooks.Open(sfol & "\" & ifn & Right(Year(Now() - 25), 2) & "_.xlsx")
Dim mks As String
Dim mgc As String
Dim sm As String
Dim FMC As Boolean
FMC = False 'want to only check that the filled length of FlgMeas & FMCol match once
Dim ret As Boolean
ret = True
Dim RArr(3) As Variant
Dim fnd As Boolean
Dim y As Integer

If sw.Detailed_Log Then
Call Update("Starting MMFProcessor. Inputs: sfol= " & sfol & "; ifn= '" & ifn & "'; x= '" & x & "'; os= '" & os.Name & "'; m= '" & m & "'; MKO= '" & MKO & "'; OName= '" & OName & "'", 0, sw)
End If

'Make sure we have as many values in the FlgMeas array's column values as in it's measure names (since they should be 1-1)
If Not FMC Then
If FilledLenS(FlgMeas(), sw, True, 0) = FilledLenS(FlgMeas(), sw, True, 2) Then
FMC = True
Else
Call Err("The Flag Measures array does not have a column reference for each measure. This will result in either (or both) " _
& "some flag measures being set incorrectly, or missed entirely in the " & OName & " list. To prevent this, the list will not" _
& " be generated. Please contact the owner of this list generator found in cell B1 of the Main tab to have this issue addressed.", _
sw)
ret = False
End If
End If

If ret Then
'Filter based on ContrCnt & TermindationDate
Call CC_TD(src.Worksheets(1))

'Map the output columns to the source columns
Dim ColDict() As String
ReDim ColDict(x, 2)
c = "A"
Dim j As Integer
j = 0
Do While os.Range(c & 1).Value <> "" And j < x And ret 'first two conditions should be redundant, but never hurts to be error proof
Dim d As String
fnd = False
d = "A"
'c is always stored
ColDict(j, 0) = c

'Find the match
Do While src.Worksheets(1).Range(d & 1).Value <> "" And fnd = False
If mks = "" Or mgc = "" Or sm = "" Then
'Also need to pull out MGC, MKS, & SM
Select Case src.Worksheets(1).Range(d & 1).Value
Case "ItemGroupCode"
mgc = d
Case "ItemKey"
mks = d
Case "SubMeasure"
sm = d
End Select
End If

If src.Worksheets(1).Range(d & 1).Value = os.Range(c & 1).Value Then
'Match, update the dictionary
ColDict(j, 1) = d
'temp = src.Worksheets(1).Range(d & 1).Value
fnd = True

Else
d = ColNumToStr(ColStrToNum(d) + 1)
End If 'else no match, in the case a match is never found (CRM_Phone2) ColDict(j, 1) should be left blank (the default)
Loop

If Not fnd Then
'The field wasn't present in the Unedited file, but is that a problem?
If InStr(1, LCase(NPU), "|" & LCase(os.Range(c & 1).Value) & "|") = 0 Then
Call Err("The '" & os.Range(c & 1).Value & "' column was not found in the Unedited " & ifn & " file. As such the report will have no data in this column.", sw)
End If 'else the field is calculated or not derived from QSI
End If 'else the value was found and nothing needs done

'Increment c & j
j = j + 1
c = ColNumToStr(j + 1)
Loop

'MMA requires special cleaning since those items from that product aren't reported
If ifn = "MMA" Then
Call MMA_Clean(src.Worksheets(1), sw, mgc, sm)
End If

'Iterate through the rows to output data
Dim k As Long 'Source row being worked with
Dim OutF As Boolean 'used to stop loop for flag column setting after column is found & set
k = 2
Do While src.Worksheets(1).Range("A" & k).Value <> "" And ret
'Product match?
'Dim og As String
'og = src.Worksheets(1).Range(mgc & k).Value
'oz = InStr(1, LCase(src.Worksheets(1).Range(mgc & k).Value), "ambetter")
If InStr(1, LCase(Prods), "|" & LCase(src.Worksheets(1).Range(mgc & k).Value) & "|") > 0 Or _
(Ambetter And InStr(1, LCase(src.Worksheets(1).Range(mgc & k).Value), "ambetter") > 0) Then
'Check if the user is new
If InStr(1, PM, "|" & src.Worksheets(1).Range(mks & k).Value & "|") = 0 Then
PM = PM & "|" & src.Worksheets(1).Range(mks & k).Value & "|"

'Output the item info
For y = 0 To x
'UnMapped column?
If ColDict(y, 1) <> "" Then
'Output the value
os.Range(ColDict(y, 0) & m).Value = src.Worksheets(1).Range(ColDict(y, 1) & k).Value
End If 'else the cell should be left blank, which is the default
Next

'Set the appropriate flag column
Call FlagSet(FlgMeas(), src, os, sm, k, m, sw, OName)

'Increment m
m = m + 1

Else
'Find the item's prior row (in general it will be the last row filled, so we'll decrement rather then increment)
Dim n As Long
n = m - 1
fnd = False
Do While n > 1 And fnd = False
If os.Range(MKO & n).Value = src.Worksheets(1).Range(mks & k).Value Then
'Set the appropriate flag column
Call FlagSet(FlgMeas(), src, os, sm, k, n, sw, OName)

fnd = True
Else
n = n - 1
End If
Loop

If Not fnd Then
'post notice if we haven't already for this item and this file
If OldOName <> OName Then
'Update OldOName and clear INotFnd
OldOName = OName
INotFnd = ""
End If

'Check if item is in INotFnd (if we've changed files INotFnd will be empty)
If InStr(1, INotFnd, "|" & src.Worksheets(1).Range(mks & k).Value & "|") = 0 Then
Call Err("Item: " & src.Worksheets(1).Range(mks & k).Value & " is noted as already being present in the " & OName & " list, but" _
& " that row could not be located to update the item's non-compliance flags, meaning one or more of the flags will be incorrect" _
& ". Please be sure to make this change manually.", sw)
INotFnd = INotFnd & "|" & src.Worksheets(1).Range(mks & k).Value & "|"
End If 'else no need to repeat for same item
End If
End If
End If 'non-<Products> users don't get reported

k = k + 1
Loop
End If 'else the arrays didn't match up and we've already notified the user

'Now we can close the workbook
src.Close SaveChanges:=False

'Fill the return array
RArr(0) = PM
RArr(1) = m
RArr(2) = ret
MMFProcessor = RArr
End Function


FlgMeas() is an array that maps the measurement columns' names to the column that measure should be output to; mks is the column letter of the column that has the item IDs

As I mentioned at the beginning, this works, but it will sometimes have to iterate back through over 20k rows to find the right one. Currently that leaves the merge taking over 2 hrs, and I've just been directed to include more files (thus why I'm wanting to shave down the run time).

So what I was hoping to get was something that works like VB Lists, where I could look-up a value (in this case the row to output to) based on a value (the ID) without having to iterate explicitly. Would Collection be the best way (as suggested in comments to the original question on Stack Overflow?

Failing any such thing existing in native VBA, would it be faster for me to maintain PM (the list of previously output IDs) as a 2D array, holding IDs & row #s, and iterate through that rather than the actual rows?

• Seems that function has a lot of irrelevant code, on top of all the code you've listed here; IMO that's a code smell pointing to a function doing way too many things and begging to be refactored into smaller, more specialized functions. The sheer number of parameters is an indication as well. If you included the entire function, reviewers could really help you clean that up. – Mathieu Guindon Jun 24 '16 at 13:36
• Added the code I had suppressed. The code was only irrelevant to the question at hand. The rest of it seems to work fairly quickly and is definitely necessary since which columns are in any given file vary, and the location of the needed columns also varies, and the suppressed code just worked around that. That said, if it can be improved as well I'm game – JMichael Jun 24 '16 at 14:31
• What's a statwin type? – Raystafarian Jun 24 '16 at 15:01
• Sorry, custom form I use to display progress & status text for the overall macro that uses the function. – JMichael Jun 24 '16 at 15:08

You can optimize your code by reading all the cells into a 2D array and then performing your analysis. Important other notes are UBound(yourarray,1) -> rows UBound(yourarray,2) -> columns

https://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/

I did a test on some code that used .cells or .range in a loop versus range.value and putting it into an array... 540k rows of data and saw my code take 7 seconds versus 113 seconds for the loop.

• TypeName(myDictionary.Count) returns Long, a 32-bit signed integer, so the capacity would be 2,147,483,647 - I would hardly call that a size limit. Do you have a source for your claim about maximum dictionary size? All I could find was "it's implicitly capped to how much memory is available, there is no hard limit". And I've worked with a Collection of thousands of items without any problems too. – Mathieu Guindon Jun 24 '16 at 13:22
• I don't think TypeName(Dictionary.Count) gives you the capacity of the object, merely the type of the return value of .Count. But I would agree that dictionary doesn't have a size limit. Must have been poor coding in my past. Although I think it would be smaller than an just an array because you have key+value arrays. – Cody Ｇ Jun 24 '16 at 14:01

I'm afraid to say I agree with ZAk -1 for your question on the basis that you don't provide your code in a usable format. You don't really make it easy to help you!

2 hours is a long time. Definitely all that writing .Value = xxx isn't helping you.

The flagSet function is invisible, so I'll ignore it.

Then you do a bunch of Cycling through columns looking for matching names. VBA has a function Range.Find. It won't save you much but it makes use of excel's functions.

Public Function MapSourceColumnsToOsColumns(ByRef src As Worksheet, ByRef os As Worksheet) As Dictionary

Dim sourceStartCell As Range
Dim sourceEndCell As Range
Dim osStartCell As Range
Dim osEndCell As Range

Dim sourceIter As Variant
Dim osFind As Range

Dim columnMap As Dictionary

Set sourceStartCell = src.Range("a1")
Set sourceEndCell = sourceStartCell.End(xlToRight)

Set osStartCell = os.Range("a1")
Set osEndCell = osStartCell.End(xlToRight)

Set columnMap = New Dictionary

Set osFind = osHeaders.Find(sourceIter, , , xlWhole)
If Not osFind Is Nothing Then
columnMap(sourceIter.Column) = osFind.Column
End If
Next sourceIter

Set MapSourceColumnsToOsColumns = columnMap

End Function


The dictionary object is an object found in "microsoft scripting runtime" library, use that instead of your ColDict array.

You also scan back to previous rows to update them, use a dictionary for this too, rather than iterate backwards, keep a record of the fields you update in the dictionary, then just use mylastUpdate(itemKey) = row

Then you keep track of columns by letter and number, totally unnecessary. VBA provides worksheet.Range(alphaNumericAddress) and worksheet.Cells(rowIndex, columnIndex) but even with this Cody G points out correctly that all your sheet accessing is killing your system. especially over 20k of rows.

Here's some pseudo code I think should happen.

1. open your statsDataFiles (os ???) files 1 at a time. (see ZAK's comments on naming. Use Find and replace
2. load all the data from the sheet into an array of variant

dim vData as variant
vData = Range("a1").currentregion

3. add all the data to a running dictionary

dim dictData = new Dictionary
...
dictData(itemKey) = vData(rowCounter, columnCounter)


At the end of these 3 steps you should have loaded all your data from multiple files into your dictData.

1. Open your storeFile (src ???)... (see Zak's note)
2. run through the sheet updating the appropriate column, row combination.

I was confused as to whether the storeFile was actually a 2d array of names and itemKeys.

if they are you can store your dictData as

dictData( itemKey & name ) = .Value

or create what is called a sparse array of dictionaries. which is just dictionaries in dictionaries.

    if dictData.Exists(itemKey) then
dictData(itemKey) = new Dictionary
end if
itemDict = dictData(itemKey)
itemDict(name) = .Value


Break out your code into different methods. Once I isolated your code into different methods, it was so much easier to understand what you were doing. (I think I understood it).

If you want to provide your code in a compiled format provide stubs of the methods you don't think are important, and actual implementation of those that are.. so it all compiles, and get rid of all references to the sw object.

public function ColNumToStr(byval val as long) as string
'stubbed function
end function
public function ColStrToNum(byval val as string) as long
'stubbed function
end function

' Keyboard shortcut Alt-D Enter to find the next non-compiling section of code.


Not that difficult to do.

Regards Good luck. Gareth

• Some follow-up questions: 1) You suggest reading the contents of each file into an array and then merging after that's done. Could that hit memory limits? I'm using over a dozen files, most with over 1k rows (some over 20k) & at least 25 columns and I feel like that's more data than I've used in a full VB program that ran out of memory. 2) I'm (obviously) not primarily a coder, but most of the code in this function would not be used in any other context, so I guess I'm curious if it really makes sense to further parcel it out, when that's more data passing to manage with not much benefit? – JMichael Jun 27 '16 at 18:03
• 1) Difficult to say how you'd be affected by memory issues, it depends on lots of things. Your machine; The version of Excel you're running; What else is running at the same time. 2) dividing your program up into pieces makes each piece easier to understand and gives your program structure. It doesn't have to be reused anywhere. By not breaking it up , you end up with large methods with lots of variables. Of course you don't have to at all, if it's your code, and if you understand it, that's all that counts. It's when you work in a team or have to hand over as support that it helps a lot. – Gareth Jun 28 '16 at 7:58

Naming

Even with your detailed description of what's going on, I've still got no idea what your code is doing, how, or why. I am constantly having to backtrack through your code to figure out what your variables are and what they're doing.

This is because your naming is atrocious. Names should be descriptive, unambiguous and concise. In that order.

Src, Mks, Mgc, sm, fmc, ret, Rarr, fnd, y, j, k, d, outF
n, sfol, ifn, x, os, prods, npu, sw, pm, statwin, FlgMeas
m, mko, Oname, ambetter


How on earth am I supposed to figure out what any of these are or what they're doing. I can't even assume that your single letter variables are simple counters, which is a universal programming convention.

You have a function called CC_TD. I have no clue what that name is supposed to indicate.

When I see a variable, I should be able to know what it is without even thinking about it.

sourceWorkbook, sourceWorksheet, idColumnAddress, nameOutputColumns
currentRow, currentId, allColumnsPresent, matchFound, fieldIsPresent


And so on and so forth. Make your names descriptive and completely unambiguous. Long and descriptive is far, far better than short and incomprehensible.

There's lots of stuff I would love to recommend for your code, but I can't figure out what things are doing and why, and if I can't understand your code, then I can't do anything with it.