Add all data wthin range then check if it already exists

Question

I'm using FileDialog to select other workbooks with this. I want to select multiple files at once.

Here is how I do it:

With fd

    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx; *.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1
    .AllowMultiSelect = True
    If .Show = -1 Then

    For Each vrtSelectedItem In .SelectedItems

            'Extract the Filename (without its file extension) to the File Path
            nPath = Mid(vrtSelectedItem, InStrRev(vrtSelectedItem, "\") + 1)
            'nPath is Filename with path
            nFilename = Left(nPath, InStrRev(nPath, ".") - 1)

             If IsWorkBookOpen(vrtSelectedItem) = True Then
                    MsgBox "File already open."
             Else

                Set wrkbk = Workbooks.Open("" & vrtSelectedItem)
                Set wrkbk_destination = ThisWorkbook '<--- this where is will add the data from files selected with FD
                Set wrkbk_source = Workbooks("" & nFilename) '<--- this the selected files

         With wrkbk_destination.Sheets("Defect Log")
         .Activate

            ' I want to add the all values within range here but check if data already exist
            ' For example selected files have data within range of D11 : I11 , D12 : I12 and D13 : I13
            ' I want to add these but if data within D12 : I12 already exist It will skip adding data and continue with
            ' D13 : I13

                    End With

I just need an example of how to do it and I will be the one to point where this added data will be display in wrkbk_destination.

Answer 1

Couple of points

1. You can do away with one of the object wrkbk or wrkbk_source
2. You don't need to check if the data already exists. Simply copy the data across as there is just a small range D11:I13 to be copied across. In the end use .RemoveDuplicates. It will be much faster.
3. You do not need to keep on activating your workbook/worksheet. You can directly perform the operation. You may want to see How to avoid using Select in Excel VBA macros

Is this what you are trying (Untested)

Sub Sample()
    '
    '~~> Rest of the code
    '

    Dim lRow As Long

    Set wrkbk_destination = ThisWorkbook

    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx;" & _
        "*.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1

        .AllowMultiSelect = True

        If .Show = -1 Then

        For Each vrtSelectedItem In .SelectedItems
             If IsWorkBookOpen(vrtSelectedItem) = True Then
                MsgBox "File already open."
             Else
                Set wrkbk_source = Workbooks.Open(vrtSelectedItem)

                With wrkbk_destination.Sheets("Defect Log")
                    lRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1

                    .Range("D" & lRow & ":I" & (lRow + 2)).Value = _
                    wrkbk_source.Sheets(1).Range("D11:I13").Value
                End With

                wrkbk_source.Close (False)
            End If
        Next vrtSelectedItem
    End With

    With wrkbk_destination.Sheets("Defect Log")
        lRow = .Range("D" & .Rows.Count).End(xlUp).Row

        '~~> Change xlNo to xlYes if the column has headers
        .Columns("D1:I" & lRow).RemoveDuplicates Columns:= _
        Array(1, 2, 3, 4, 5, 6), Header:=xlNo
    End With
End Sub