List(Of ) like operation in macro

Question

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
                'New add them to PM
                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?

Answer 1

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.

Answer 2

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 sourceHeaders As Range
    Dim osHeaders 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 sourceHeaders = src.Range(sourceStartCell, sourceEndCell)
    Set osHeaders = os.Range(osStartCell, osEndCell)

    Set columnMap = New Dictionary

    For Each sourceIter In sourceHeaders
        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.

Add the data base

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

Answer 3

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.