Kind of like a reverse pivot in Excel VBA 2007

Question

I have searched and found a number of similar questions (here and elsewhere) but I can't get my head around how to adapt to my needs. Usually I find pivot like Pivot data using VBA and either I can't figure out how to properly search for (describe) what I need, or I am missing something.

I get the data (up to 30K rows) of Subject/Category pairs and count/group them to get:

Subject  Category   Count
  A         C1         1
  A         C2         4
  B         C1         8
  B         C2         1
  B         C3         2
  C         C2         4

I need the data to appear as

Subject     C1     C2     C3
  A          1      4      0
  B          8      1      2
  C          0      4      0

Is there a way to achieve this using Excel VBA? I tried going directly to this format from the raw data, but couldn't figure that out, so was hoping this way would work better.

Any help would be immensely appreciated--even if it's to tell me how to search for solutions to this better.

EDIT: Oh yeah, and the list of Categories is not the same on each run of this data. Has to be done regularly, and will change from one time to the next. So I was looking to figure out how to grow the Categories from left to right as they appear (then I can always sort them afterwards)...

Is the data sorted already by subject? Then category? – peege Nov 27 '14 at 01:59 — peege, Nov 27 '14 at 01:59

score 0 · Answer 1 · answered Nov 27 '14 at 02:22

Whether this standard/array formula solution is viable for your situation will depend upon the number of values you are looking into. Array formulas eat up CPU cycles logarithmically as your data table grows.

[Unique Transposed Data

The array formula in F1 is,

=IF(LEN(E1), IFERROR(INDEX($B$2:$B$999,MATCH(0, IF(LEN($B$2:$B$999), COUNTIF($E$1:E$1,$B$2:$B$999&""),1),0)),""),"")

Use Ctrl+Shift+Enter to finalize then fill right as far as you like to allow for future additions.

The array formula in E2 is,

=IF(LEN(E1), IFERROR(INDEX($A$2:$A$999,MATCH(0, IF(LEN($A$2:$A$999), COUNTIF($E$1:$E1,$A$2:$A$999&""),1),0)),""),"")

Use Ctrl+Shift+Enter to finalize then fill down as far as you like to allow for future additions.

The standard formulka in F2 is,

=IF(AND(LEN(F$1),LEN($E2)),IFERROR(INDEX($C$2:$C$999, MIN(INDEX(ROW($1:$998)+(($A$2:$A$999<>$E2)+($B$2:$B$999<>F$1))*1E+99,,))),0),"")

Use Enter to finalize. Fill both right and down (plus a few extra rows/columns for future entries).

Here is another image after I type a new entry into A8:C8.

[Unique Transposed Data 2

Could not get this to work with my data set size (~30000 rows on average). Thanks though. :) — dt647146, Nov 27 '14 at 16:34

score 0 · Accepted Answer · edited May 08 '18 at 21:49

Assuming you have sorted Sheet1 by subject. I will put some pieces together for you. This is untested as is, because it's not complete. However, these concepts will get you what you want to accomplish.

I would start by creating a second sheet. You will need to keep track of which row you are working on as you go through Sheet1.

Dim tRow As Long   'tRow to represent the target row, one for each subject on Sheet1
tRow = 1           'Start on row 1, the code below takes into account the header row

Establish the lastRow on Sheet1.

lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

Get all the unique category names on Sheet1. You can build an array of the categories. "categoryList()"

This LINK to Chip Pearson's page has a lot of good information on building arrays from distinct values.

Use those names to build your column headers on Sheet2. Perform a loop

For c = 0 To UBound(categoryList)
    Sheets("Sheet2").Cells(1, c + 2) = categoryList(c)   'c+2 because column 2 is the first Category
Next c

Row by row, go through Sheet1. Set a variable named "lastSubject" and compare the value in Column A of the row to lastSubject.

Dim lastSubject As String
lastSubject = ""
For r = 2 To lastRow
    If Sheets("Sheet1").Cells(r, 1) <> lastSubject Then
        lastSubject = Sheets("Sheet1").Cells(r, 1)  
        tRow = tRow + 1     'Add 1 to target row on Sheet2, because the subject changed.
        Sheets("Sheet2").Cells(tRow, 1) = Sheets("Sheet1").Cells(r, 1)   'Set the Subject on Sheet2
    End If

    For c = 0 to UBound(categoryList)
        If Sheets("Sheet1").Cells(r, 2).Value = categoryList(c) Then
            Sheets("Sheet2").Cells(tRow, c + 2) = Sheets("Sheet1").Cells(r, 3)  'Set the Count
        End If
    next c       
next r

Thanks. I was able to find a good way to get the array of unique values [link](http://stackoverflow.com/questions/5890257/populate-unique-values-in-to-vba-array-from-excel) and was able to modify/complete it to suite my needs (~30000 rows at a time). Thanks!! — dt647146, Nov 27 '14 at 16:33
Glad to hear it. I wish I had more time to include the code for that originally. — peege, Nov 27 '14 at 16:39

Kind of like a reverse pivot in Excel VBA 2007

2 Answers2