Text in pivot table

G

green biro

I'm aware that summary functions will not work for text data in Excel 2000
(eg something like 'first' in Access crosstabs doesn't exist). Two
questions:
- Is this functionality available in later versions?
- What are the alternatives (eg anyone got some VBA they've used to do it)?

Thanks

GB
 
D

Dave Peterson

Pivottables are still quantitative summaries.

You may want to give more info about what your data looks like and what you
want. I might lead to better alternatives.
 
G

green biro

You may want to give more info about what your data looks like and what you
want. I might lead to better alternatives.
Click to expand...

My data is test grades and might look like this.

alex, testA, 3C
alex, testC, 2A
alex, testD, 1C
bob, testA, 2A
bob, testB, 2A
charles, testB, 3A
charles, testC, 2B
etc

I would then want to cross tabulate the results with the test identifiers
being the column headings.

I twould be even better if I could have duplicates (eg two marks for charles
testB) and display the best but that could be left to phase 2!

Thanks in advance for any guidance.

GB
 
D

Dave Peterson

This seemed to work ok for me:

Option Explicit
Sub testme()
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim myRng As Range
Dim myCell As Range
Dim myCol As Long
Dim myRow As Long
Dim myStr As String

Set curWks = Worksheets("Sheet1")
Set newWks = Worksheets.Add

With curWks
With .Range("a1:c" & .Cells(.Rows.Count, "A").End(xlUp).Row)
.Sort key1:=.Columns(1), order1:=xlAscending, _
key2:=.Columns(2), order2:=xlAscending, _
key3:=.Columns(3), order3:=xlAscending, _
header:=xlYes
End With
.Range("a1", .Cells(.Rows.Count, "A").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=newWks.Range("A1"), _
Unique:=True
.Range("b1", .Cells(.Rows.Count, "B").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=newWks.Range("b1"), _
Unique:=True
End With

With newWks
With .Range("a1").EntireColumn
.Cells.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With
With .Range("b1").EntireColumn
.Cells.Sort key1:=.Columns(1), order1:=xlAscending, header:=xlYes
End With
.Range("b2", .Cells(.Rows.Count, "B").End(xlUp)).Copy
.Range("b1").PasteSpecial Transpose:=True
.Range("b2", .Cells(.Rows.Count, "B").End(xlUp)).ClearContents
End With

With curWks
Set myRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
For Each myCell In myRng.Cells
myRow = Application.Match(myCell.Value, newWks.Range("a:a"), 0)
myCol _
= Application.Match(myCell.Offset(0, 1).Value, newWks.Rows(1), 0)

If IsError(myRow) _
Or IsError(myCol) Then
'this shouldn't ever happen--but just in case
MsgBox "error with: " & myCell.Address(0, 0)
Else
myStr = newWks.Range("a1").Cells(myRow, myCol).Value
If myStr = "" Then
myStr = myCell.Offset(0, 2).Value
Else
myStr = myStr & ", " & myCell.Offset(0, 2).Value
End If
newWks.Range("a1").Cells(myRow, myCol).Value = myStr
End If
Next myCell
End With

newWks.UsedRange.Columns.AutoFit

End Sub

I do assume that you have a single header row (1) on sheet1. And it sorts your
original data (but you can delete that portion if you want.

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
G

green biro

This is fantastic! I am truly indebted.
I will go through the code step by step to increase my own knowledge.
Thanks.

GB
 
Top