Macro enhancement to control output data

I received help with developing this macro from dlmille (Dave). I now need for the macro to only populate data if the data is not already present. The field D, "Reconstruction ID". If that data is present then the routine to move the data can be skipped, read the next record, check it etc. Attached is the excel spreadsheet output with some results already populated plus a folder with input files. The spreadsheet macro reads through each file in the folder an populates every line with a record. Now it needs to begin populating after the last record with new records. Thanks for your help and let me know if you have questions. Janis
MCU-File-Review-Summary-Detail-N.xlsm
DeRoy--Shelia-P01-3-19-2012-QC.xlsx
Everly--Gloria-P01-2-20-2012-QC.xlsx
Fields-Murphy--Rebecca-P01-3-18-.xlsx
DMKetcherConsultantAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

dlmilleCommented:
As requested, added all the existing reconstruction id's to a dictionary (which can only hold unique values), then as workbooks are processed, the id is tested and skipped if a match is found.  The use of dictionary is a VERY FAST way to compare an item with a collection.

For more on the Dictionary Class (I use it more and more) see matthewspatrick's great article on the subject:
http://www.experts-exchange.com/searchResults.jsp?searchTerms=matthewspatrick+dictionary&componentHtmlId=basicSearch&searchType=10

Here's the revised code in the main routine:
Sub ProcessFilesInFolder()

Dim dstWkb As Workbook
Dim dstSht As Worksheet
Dim srcWkb As Workbook
Dim srcSht As Workbook
Dim dirResult As String
Dim fName As String
Dim fpathName As String
Dim rDest As Range
Dim myDict As Object 'Dictionary holding unique reconstruction ID's
Dim xMsg As Long

    Application.ScreenUpdating = False

    'Setup variables for this workbook and destination worksheets

    Set dstWkb = ThisWorkbook
    Set dstSht = dstWkb.Sheets("Data_Pull")
    Set myDict = CreateObject("Scripting.Dictionary")
    
    'load existing reconstruction ID's into dictionary
    For Each r In dstSht.Range("D7", dstSht.Range("D" & dstSht.Rows.Count).End(xlUp))
        If Not myDict.exists(r.Value) Then
            myDict.Add r.Value, Nothing
        ElseIf xMsg <> vbYes Then 'if already asked then don't prompt again
            xMsg = MsgBox("You already have duplicate reconstruction ID's in the source sheet (" & r.Value & ")", vbYesNo, "Continue Anyway (YES), Abort (NO)")
            If xMsg = vbNo Then GoTo gracefulExit
        End If
    Next r
    
    'prompt user for directory from which to find import workbooks.
    'Assumes all workbooks are .xlsx and no other workbooks exist (or change filter criteria)

    dirResult = browseForFolder(ThisWorkbook.Path & "\", "Select Path for Import Files")
    'dirResult = "C:\Users\jketcher\Documents\Janis Folder November 6\MCU\MCU_Workbooks_Mid_Format"


    If dirResult <> "" Then

        'Process all files in folder
        fName = Dir(dirResult & "\*")
        'fName = Dir(dirResult & "\*.xlsx")
        'fetch first file in folder meeting this criteria

        If fName <> "" Then
            On Error Resume Next    'need to do error checking to ensure successful file open on every file

            Do
                Application.StatusBar = "Processing file: " & fName
                fpathName = dirResult & "\" & fName
                Set srcWkb = Workbooks.Open(Filename:=fpathName, UpdateLinks:=False, ReadOnly:=True)

                If Not srcWkb Is Nothing Then
                    'establish row to populate for all 3 macros
                    Set rDest = dstSht.Range("A" & dstSht.Rows.Count).End(xlUp).Offset(1, 0)
                    If rDest.Row < 7 Then
                        Set rDest = dstSht.Range("A7")
                    End If
                    'check to see if the Reconstruction ID already exists
                    If Not myDict.exists(srcWkb.Sheets("Courses").Range("B4").Value) Then
                        Call DataTransfer(srcWkb, rDest)
                        Call DataTransfer2(srcWkb, rDest)
                        Call DataTransfer3(srcWkb, rDest)
                    End If
                    srcWkb.Close savechanges:=False
                End If

                fName = Dir    'Get Next File
            Loop Until fName = ""
        End If
    End If

gracefulExit:
    myDict.RemoveAll
    Set myDict = Nothing
    Application.StatusBar = False
    Application.ScreenUpdating = True
End Sub

Open in new window


See attached demonstration workbook.

Dave
MCU-File-Review-Summary-Detail-N.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
DMKetcherConsultantAuthor Commented:
Thanks so much. I will work on it today and get back to you. I appreciate the educational tips.

Janis
0
DMKetcherConsultantAuthor Commented:
Thanks so much!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.