VBA, Расширенный фильтр и удаление дубликатов

у меня есть список, полный разных путей в col A. У меня есть список деталей в B и C.

как я могу на новом листе: 1) вытащить каждый уникальный путь, 2) для каждого пути скомпилировать значения из B * C и удалить дубликаты. 3) повторить следующий путь после того, как это сделано в последней строке.

у меня есть неисправный макрос, но ради краткости и точности я не буду публиковать. Если только кто-то не хочет прочитать это, пожалуйста reques

любая помощь была бы весьма признательна.

вот что у меня есть(я понимаю его долго, я попробую очистить его abit):

Sub FileDetail()
'Does not fill down, go to bottom to unleased fill down
'Skips unreadable files
'This Macro retrieves data from files picked. The data is based on header. Data is also filtered for unique values.
'You must make sure headers are in the first row and delimted.


Dim wb As Workbook, fileNames As Object, errCheck As Boolean
    Dim ws As Worksheet, wks As Worksheet, wksSummary As Worksheet
    Dim y As Range, intRow As Long, i As Integer

Dim r As Range, lr As Long, myrg As Range, z As Range
    Dim boolWritten As Boolean, lngNextRow As Long
    Dim intColNode As Integer, intColScenario As Integer
    Dim intColNext As Integer, lngStartRow As Long
    Dim lngLastNode As Long, lngLastScen As Long
    Dim intColinstrument As Integer, lngLastinstrument As Long



   'Skipped worksheet for file names
   Dim wksSkipped As Worksheet
   Set wksSkipped = ThisWorkbook.Worksheets("Skipped")


     ' Turn off screen updating and automatic calculation
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

     ' Create a new worksheet, if required
    On Error Resume Next
    Set wksSummary = ActiveWorkbook.Worksheets("Unique data")
    On Error GoTo 0
    If wksSummary Is Nothing Then
        Set wksSummary = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
        wksSummary.Name = "Unique data"
    End If

     ' Set the initial output range, and assign column headers
    With wksSummary
        Set y = .Cells(.Rows.Count, 3).End(xlUp).Offset(1, 0)
        Set r = y.Offset(0, 1)
        Set z = y.Offset(0, -2)
        lngStartRow = y.Row
        .Range("A1:E1").Value = Array("File Name", "Sheet Name", "Node", "Book", "Instrument")
    End With

'get user input for files to search
Set fileNames = CreateObject("Scripting.Dictionary")
errCheck = UserInput.FileDialogDictionary(fileNames)
If errCheck Then
   Exit Sub
End If
'''
For Each Key In fileNames 'loop through the dictionary




On Error Resume Next
Set wb = Workbooks.Open(fileNames(Key))
If Err.Number <> 0 Then
    Set wb = Nothing    ' or set a boolean error flag
End If
On Error GoTo 0    ' or your custom error handler

If wb Is Nothing Then
wksSkipped.Cells(wksSkipped.Cells(wksSkipped.Rows.Count, "A").End(xlUp).Row + 1, 1) = fileNames(Key)

Else
    Debug.Print "Successfully loaded " & fileNames(Key)
    wb.Application.Visible = False 'make it not visible
    ' more working with wb




 ' Check each sheet in turn
    For Each ws In ActiveWorkbook.Worksheets
        With ws
             ' Only action the sheet if it's not the 'Unique data' sheet
            If .Name <> wksSummary.Name Then
                boolWritten = False



       ''''''''''''''''''testing additional column..trouble here



                                 ' Find the Anchor Date
                intColScenario = 0
                On Error Resume Next
                intColScenario = WorksheetFunction.Match("instrument.instrumentType", .Rows(1), 0)
                On Error GoTo 0

                If intColScenario > 0 Then
                     ' Only action if there is data in column E
                    If Application.WorksheetFunction.CountA(.Columns(intColScenario)) > 1 Then
                       lr = .Cells(.Rows.Count, intColScenario).End(xlUp).Row


                         ' Copy unique values from the formula column to the 'Unique data' sheet, and write sheet & file details
                        .Range(.Cells(1, intColScenario), .Cells(lr, intColScenario)).AdvancedFilter xlFilterCopy, , r, True
                        r.Offset(0, -2).Value = ws.Name
                        r.Offset(0, -3).Value = ws.Parent.Name



                         ' Delete the column header copied to the list
                        r.Delete Shift:=xlUp
                        boolWritten = True
                    End If
                End If

          ''''''''''''''''''''''''''''''''''''below is working'''''''''''''''''''''''

                 ' Find the Desk column
                intColNode = 0
                On Error Resume Next
                intColNode = WorksheetFunction.Match("book.reportingLine.pathName", .Rows(1), 0)
                On Error GoTo 0

                If intColNode > 0 Then
                     ' Only action if there is data in column A
                    If Application.WorksheetFunction.CountA(.Columns(intColNode)) > 1 Then
                        lr = .Cells(.Rows.Count, intColNode).End(xlUp).Row

                         ' Copy unique values from column A to the 'Unique data' sheet, and write sheet & file details (if not already written)
                        .Range(.Cells(1, intColNode), .Cells(lr, intColNode)).AdvancedFilter xlFilterCopy, , y, True
                        If Not boolWritten Then
                            y.Offset(0, -1).Value = ws.Name
                            y.Offset(0, -2).Value = ws.Parent.Name
                        End If

                         ' Delete the column header copied to the list
                        y.Delete Shift:=xlUp
                    End If
                End If

          ' Find the Intrument
                intColinstrument = 0
                On Error Resume Next
                intColinstrument = WorksheetFunction.Match("instrument.instrumentType", .Rows(1), 0)
                On Error GoTo 0

                If intColinstrument > 0 Then
                     ' Only action if there is data in column A
                    If Application.WorksheetFunction.CountA(.Columns(intColinstrument)) > 1 Then
                        lr = .Cells(.Rows.Count, intColinstrument).End(xlUp).Row

                         ' Copy unique values from column A to the 'Unique data' sheet, and write sheet & file details (if not already written)
                        .Range(.Cells(1, intColinstrument), .Cells(lr, intColinstrument)).AdvancedFilter xlFilterCopy, , z, True
                        If Not boolWritten Then
                            z.Offset(0, -3).Value = ws.Name
                            z.Offset(0, -4).Value = ws.Parent.Name
                        End If

                         ' Delete the column header copied to the list
                        z.Delete Shift:=xlUp
                    End If
                End If




         ' Identify the next row, based on the most rows used in columns C & D
                lngLastNode = wksSummary.Cells(wksSummary.Rows.Count, 3).End(xlUp).Row
                lngLastScen = wksSummary.Cells(wksSummary.Rows.Count, 4).End(xlUp).Row
                lngLastinstrument = wksSummary.Cells(wksSummary.Rows.Count, 5).End(xlUp).Row
                lngNextRow = WorksheetFunction.Max(lngLastNode, lngLastScen) + 1

                If (lngNextRow - lngStartRow) > 1 Then

                   ' Fill down the workbook and sheet names
                    z.Resize(lngNextRow - lngStartRow, 2).FillDown


                    ''''''''Optional if you want headers to be filled down.

                    'If (lngNextRow - lngLastNode) > 1 Then


                         ' Fill down the last Node value
                        'wksSummary.Range(wksSummary.Cells(lngLastNode, 3), wksSummary.Cells(lngNextRow - 1, 3)).FillDown
                    'End If
                    'If (lngNextRow - lngLastScen) > 1 Then
                         ' Fill down the last Scenario value
                        'wksSummary.Range(wksSummary.Cells(lngLastScen, 4), wksSummary.Cells(lngNextRow - 1, 4)).FillDown
                    'End If


                End If



                Set y = wksSummary.Cells(lngNextRow, 3)
                Set r = y.Offset(0, 1)
                Set z = y.Offset(0, -2)
                lngStartRow = y.Row
            End If
        End With
    Next ws
wb.Close savechanges:=False 'close the workbook do not save
Set wb = Nothing 'release the object
End If

Next 'End of the fileNames loop
Set fileNames = Nothing

 ' Autofit column widths of the report
wksSummary.Range("A1:E1").EntireColumn.AutoFit

' Reset system settings
With Application
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
   .Visible = True
End With
End Sub

таким образом, этот код получает имя файла, имя листа и столбцы, которые я указываю.

1) однако у меня возникли проблемы с добавлением дополнительных столбцов к этому. (В настоящее время я получаю 2 извлеченных столбца), а также

2) у меня проблемы поместите его в формат, где его столбцы основаны друг на друге. ex это даст мне уникальное значение для каждого пути, но тогда не уникальные значения для каждого вида спорта.

Edit для включения данных ( я также хотел бы включить 4-й и 5-й столбец, но сохранил его до 3 Для простоты):

+-------------------------------+------------+--------------+
| path                          | sport      | Teams        |
+-------------------------------+------------+--------------+
| stack/over/flow/larrybird     | basketball | celtics      |
+-------------------------------+------------+--------------+
| stack/over/flow/michaeljordan | basketball | bulls        |
+-------------------------------+------------+--------------+
| stack/over/flow/tigerwoods    | golf       | pga          |
+-------------------------------+------------+--------------+
| stack/over/flow/josebautista  | baseball   | bluejays     |
+-------------------------------+------------+--------------+
| stack/over/flow/jordanspeith  | golf       | pga          |
+-------------------------------+------------+--------------+
| stack/over/flow/kevinlove     | basketball | timberwolves |
+-------------------------------+------------+--------------+
| stack/over/flow/lebronjames   | basketball | cavs         |
+-------------------------------+------------+--------------+
| stack/over/flow/stephencurry  | basketball | warriors     |
+-------------------------------+------------+--------------+
| stack/over/flow/larrybird     | baseball   | redsox       |
+-------------------------------+------------+--------------+
| stack/over/flow/michaeljordan | baseball   | whitesox     |
+-------------------------------+------------+--------------+
| stack/over/flow/michaeljordan | chess      | knight       |
+-------------------------------+------------+--------------+
| stack/over/flow/michaeljordan | basketball | hornets      |
+-------------------------------+------------+--------------+
| stack/over/flow/kevinlove     | basketball | cavs         |
+-------------------------------+------------+--------------+
| stack/over/flow/tigerwoods    | golf       | pga          |
+-------------------------------+------------+--------------+

и ожидаемый результат (я включил заполнить вниз в этом)

+-------------------------------+------------+--------------+
| path                          | sport      | teams        |
+-------------------------------+------------+--------------+
| stack/over/flow/larrybird     | basketball | celtics      |
+-------------------------------+------------+--------------+
|                               | baseball   | red sox      |
+-------------------------------+------------+--------------+
| stack/over/flow/tigerwoods    | golf       | pga          |
+-------------------------------+------------+--------------+
| stack/over/flow/michaeljordan | basketball | bulls        |
+-------------------------------+------------+--------------+
|                               |            | hornets      |
+-------------------------------+------------+--------------+
|                               | baseball   | whitesox     |
+-------------------------------+------------+--------------+
|                               | chess      | knight       |
+-------------------------------+------------+--------------+
| stack/over/flow/kevinlove     | basketball | timberwolves |
+-------------------------------+------------+--------------+
|                               |            | cavs         |
+-------------------------------+------------+--------------+
| stack/over/flow/josebautista  | baseball   | bluejays     |
+-------------------------------+------------+--------------+

похоже, это проблема для 3-го (4-го и 5-го также) столбцов с получением уникальных значений.