Grouping Data by Category and SubCategories and Summarizing unique data

[mgcarino14]

Dear Experts,
I need help with writing a VBA code that will group data under a category and sub-categories and summarize unique data by using data suffix.

Attached is the sample spreadsheet.

Output1: From the raw file, group each data (File ID) under each category (Folder) and sub-category (Sub-Folder)

Output 2:
ColA: Summarize all File IDs
ColB: Unique suffix data (value before first dash of the File ID)
ColC: Value of Concatenated ColB Data, separated by Vertical Bar Pipe


Thank you!

[jindon]

Try

Sub test()
    Dim myAreas As Areas, r As Range, x, e, dic As Object
    Dim i As Long, ii As Long, subF As String, suFix As String
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    Set myAreas = Sheets("raw data").Columns(1).SpecialCells(2).Areas
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In myAreas
            If r.Count > 2 Then
                If Not .exists(r(2).Value) Then
                    Set .Item(r(2).Value) = CreateObject("Scripting.Dictionary")
                End If
                subF = Trim$(Split(r(3), "FileIDs:")(0))
                x = Split(Split(Application.Trim(r(3)), ": ")(1), ", ")
                .Item(r(2).Value)(subF) = x
            End If
        Next
        Cells(1, "c").CurrentRegion.EntireColumn.Clear
        Cells(1, .Count + 4).CurrentRegion.Clear
        Cells(1, .Count + 4).Resize(, 3).Value = Array("ALL FILE IDs", _
            "UNIQUE FILE ID SUFFIX", "UNIQUE FILE IDSUFFIX SUMMARY")
        For i = 0 To .Count - 1
            Cells(1, i + 3).Value = .keys()(i)
            For ii = 0 To .items()(i).Count - 1
                Cells(Rows.Count, i + 3).End(xlUp)(3) = .items()(i).keys()(ii)
                x = Application.Transpose(.items()(i).items()(ii))
                Cells(Rows.Count, i + 3).End(xlUp)(2).Resize(UBound(x)).Value = x
                Cells(Rows.Count, .Count + 4).End(xlUp)(2).Resize(UBound(x)).Value = x
                For Each e In x
                    dic(Split(e, "-")(0)) = Empty
                Next
            Next
        Next
        Cells(2, .Count + 5).Resize(dic.Count).Value = Application.Transpose(dic.keys)
        Cells(2, .Count + 6).Value = Join(dic.keys, " | ")
    End With
    Columns.AutoFit
End Sub

[mgcarino14]

@jindon. Super! That works! Thank you!

[mgcarino14]

@Jindon - I expanded my data and I am having "Runtime Error Mismatch 13" on this line:

x = Split(Split(Application.Trim(r(3)), ": ")(1), ", ")

It happens when characters after "FIleIDs:" go beyond 235 characters.

Example:
Location
Folder 3
SubFolder2 FileIDs: 12346-4, 56787-6, 56787-11, 56787-4, 789014-5, 11111-1, 111111-2, 1111111-3, 1111111-5, 1111111-6, 12111113-1, 12346-4, 56787-6, 56787-11, 56787-4, 789014-5, 11111-1, 111111-2, 1111111-3, 1111111-5, 1111111-6, 12111113-1, XYZ-1, 11334-1

[jindon]

Try change that line to

                x = Split(Trim$(Mid$(r(3), InStr(r(3), ": ") + 3)), ", ")

[mgcarino14]

Thank you @Jindon, that fixed that error.