CODEWITHSUNDEEP
vbaexcelexcel-formula
Emma
Emma

Reputation: 562

Excel Data Summary By Text Value - Similar to Pivot table

Wonder if someone can point me in the right direction. I have a spreadsheet of 200,000 + rows example below. (The part number is alphanumeric)

Part Number       Areacode          Description
1                 1                 Table
2                 1                 Chair
3                 1                 Bookcase
7                 1                 Bookcase
4                 2                 Table
5                 2                 Shelf
6                 3                 Chair
8                 3                 Chair

I am trying to achieve this

Area Code         Table            Chair            Bookcase            Shelf
1                 1                2                3,7
2                 4                                                     5
3                                  3,8

I thought the Pivot table might have been the ideal solution but I have tried this and unfortunately I cannot see it is possible to add in the actual text values into the sum area. I am guessing the only way forward is some sort of Macro ?

2 months on and Still need help on this guys if anyone has any ideas

Upvotes: 1

Views: 743

Answers (2)

Tim Williams
Tim Williams

Reputation: 166256

Sub Tester()
    Dim rngIn, rngOut

    Set rngIn = Sheets("Data")
    Set rngOut = Sheets("Pivoted")

    rngOut.CurrentRegion.ClearContents

    PivotRange rngIn, 2, 3, 1, rngOut
End Sub


Function PivotRange(rngIn, rowCol, catCol, valCol, rngOut)
    Dim dictRows, dictCols, r, nR, nC, arr, kR, kC

    Set dictRows = CreateObject("scripting.dictionary")
    Set dictCols = CreateObject("scripting.dictionary")

    arr = rngIn.Value

    Application.ScreenUpdating = False
    rngOut.Value = arr(1, rowCol) 'row header

    For r = 2 To UBound(arr, 1) 'skip column headers
        kR = arr(r, rowCol)
        kC = arr(r, catCol)
        If Not dictRows.exists(kR) Then
            nR = nR + 1
            dictRows.Add kR, nR
            rngOut.Offset(nR, 0).Value = kR
        End If
        If Not dictCols.exists(kC) Then
            nC = nC + 1
            dictCols.Add kC, nC
            rngOut.Offset(0, nC).Value = kC
        End If
        With rngOut.Offset(dictRows(kR), dictCols(kC))
            .Value = .Value & IIf(.Value <> "", ",", "") & arr(r, valCol)
        End With
    Next r

End Function

Upvotes: 0

Emma
Emma

Reputation: 562

I have completed the task but I am sure there may be quicker ways to achieve this. The solution was to download the Ablebits Combine Rows program from https://www.ablebits.com/

This allowed me to concatenate the part numbers based on area code so in my main table I now have for area code 3. Part number = 3 , 8 and Description = Chair

Then I inserted a new column and gave everything a unique number identifier.

After which I ran a pivot table to give area code as vertical value, description as horizontal value and in the calculation field set this as the new unique identifier field and to value min. max or product.

Then I copied and pasted the pivot table into a new sheet and did a lookup on each of the unique identifiers to get the actual part number as text values - This was the time consuming bit as it took 70 VLookups.

I'd still be interested in hearing any faster ways of doing this.

Thanks.

Upvotes: 1

Related Questions