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).
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 'workbook containing the info to copy to unified list
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 'whether the function completed successfully
ret = True 'easier to ID failures rather than only setting to True on success
Dim RArr(3) As Variant 'return
Dim fnd As Boolean
Dim y As Integer
'...(non-relevant code)
'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?
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 item is new
If InStr(1, PM, "|" & src.Worksheets(1).Range(mks & k).Value & "|") = 0 Then
'New add it to PM
PM = PM & "|" & src.Worksheets(1).Range(mks & k).Value & "|"
'Output the descriptive 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 row (in general it will be the last row filled, so we'll decrement from the end of the list rather then increment from the start)
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 measurement values, meaning one or more of the values 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> items don't get reported
k = k + 1
Loop
End If 'else the arrays didn't match up and we've already notified the user
'...(more irrelevant code)
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.
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?
Thanks in advance!
Aucun commentaire:
Enregistrer un commentaire