I am fairly new to Excel VBA.

I have a set of matching values as shown in the picture attached:

The input is a table with Order no in the 1st column and dates in the 7th column. I would like to extract all the matching dates from the 7th column and display only the 'unique dates' in the columns against each matching order value. I use excel 2016 . The Inputs are in sheet 2.

I managed to get the dates with array index formula but it gets slow with large data. Any help would be great.

Thanks.

CodePudding user response：

If you have access to the new array functions UNIQUE & FILTER then:

Using the sample data below

1. In cell E1: =UNIQUE(A1:A10)
2. In cell F1: =TRANSPOSE(UNIQUE(FILTER(B1:B10,A1:A10=E1)))
3. Then drag the formula from F1 down to the last cell which will populate your desired table.

CodePudding user response：

Please, try the next VBA solution. It should be very fast, using two dictionaries and arrays, mostly working in memory. It will return the processed result starting from "J2" cell. It can return anywhere, you should only change "J2" cell with the cell range you need, even being in another sheet:

Sub extractUniqueValues_Dat()
   Dim sh As Worksheet, lastR As Long, arr, arrIt, arrFin, Z As Long
   Dim dict As Object, dictI As Object, i As Long, k As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
   
   arr = sh.Range("A2:G" & lastR).value             'place the range to be processed in an array, for faster iteration
   Set dict = CreateObject("Scripting.Dictionary")  'set first necessary dictionary
   
   For i = 1 To UBound(arr) 'iterate between the array rows and load the dictionary:
        If Not dict.Exists(arr(i, 1)) Then                     'if the key does not exist:
            Set dictI = CreateObject("Scripting.Dictionary")   'set a new dictionary
            dictI.Add arr(i, 7), vbNullString                  'create a key of the new dictionary using first Date occurrence
            dict.Add arr(i, 1), dictI                          'create a dictionary key as Value and add the new dictionary as item
            If dictI.count > Z Then Z = dictI.count            'extract maximum number of Date occurrences
        Else
           dict(arr(i, 1))(arr(i, 7)) = vbNullString           'if the key of the item dictionary does not exist it is added, with an empty item
           If dict(arr(i, 1)).count > Z Then Z = dict(arr(i, 1)).count 'extract maximum number of Date occurrences
        End If
   Next i
   ReDim arrFin(1 To dict.count, 1 To Z   1) '  1, to make place for the dictionary key (in first column)
   
   'fill the arrFin array:
   For i = 0 To dict.count - 1
        arrFin(i   1, 1) = dict.Keys()(i)                        'place the main dictionary key in the first column of the final array
        For k = 1 To dict.Items()(i).count
            arrFin(i   1, 1   k) = dict.Items()(i).Keys()(k - 1) 'place each date (extracted from the item dictionary keys) in the following columns
        Next k
   Next i
   
   'build the header:
   Dim arrH: arrH = Evaluate("TRANSPOSE(ROW(1:" & Z & "))")
   arrH = Split("Match Value|Data " & Join(arrH, "|Data "), "|")
   
   'drop the final aray content and apply a little formatting:
   With sh.Range("J2").Resize(UBound(arrFin), UBound(arrFin, 2))
        .value = arrFin
        With .rows(1).Offset(-1)
            .value = arrH
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
        End With
        .EntireColumn.AutoFit
   End With
   
   MsgBox "Ready..."
End Sub

Please send some feedback after testing it.