Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Formular or macro to calculate and transpose data 1

Status
Not open for further replies.

Brianfree

Programmer
Feb 6, 2008
220
GB
Hi, i have some data that i need to sort and seperate into different fields. Is there a function(s) to do this or a macro? Really stuck at the moment and running out of ideas.. I have tried countif function to calculate but doesnt quite work for me.. Please see an example of what data i have got and what i want to achieve...

Existing Data:

Code:
Data	Value
1	a
2	b
3	c
1	d
1	e
4	f
5	f
6	g
7	a
7	b
8	c
9	d
1	f

What i want to display...

Code:
data	count	value 1	value 2	value 3	value 4
1	4	a	d	e	f
2	1	b			
3	1	c			
4	1	f			
5	1	f			
6	1	g			
7	2	a	b		
8	1	c			
9	1	d

Many thanks,

Brian
 
I put the data in a Table named tbData and then made a PivotTable of it in cell E1. I then put the following array formula in cell G2 and copied across and down:
=IFERROR(INDEX(tbData[Value],SMALL(IF(tbData[Data]=$E2,ROW(tbData[Data])-ROW(tbData[[#Headers],[Data]]),""),COLUMNS($G2:G2))),"")

This formula, which must be array-entered because of the IF inside the SMALL, returns the Value for each Data in sequence. When the list is exhausted, the formula returns an empty string (looks like a blank). The formula requires Excel 2007 or later because of IFERROR and the structured references to the Table.

Here is a sample workbook on my Skydrive:

Brad
 
Byundt,

How do I grab a copy of your offering? I can open it up OK, but when I try to get it across to Excel I get asked to log into something. When I then decline to do that (since I have no username / password for whatever it is I am being told to log into) my Firefox freezes unthawably.
 
According to Microsoft's web page for Skydrive, you shouldn't be asked to present a username or password.

Try this link to the entire Public folder in my Skydrive. You want the file called ListMembersOfPT

If still no joy, my Email address is my screen name here at alum.mit.edu

Brad



 
You may have been having problems because I had the file open.

I use Firefox also, and was able to open the file, then do a SaveAs using what appeared to be an Excel link. The file certainly downloaded OK.

I've closed it now, so please give it another whirl.

Brad
 
Same problem again. (But I got the file by following your "entire Public folder in my Skydrive" suggestion.)
Thanks.
 
Here's a macro that will do what you're asking. Normally, you should ask this in the VBA Visual Basic for Applications (Microsoft).
Code:
Sub Brian()
Dim count As Integer, v As Integer, dROW As Integer
Dim Data As String, Value As String
    

    Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(2, 1), Cells(2, 1).End(xlDown)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(2, 2), Cells(2, 2).End(xlDown)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(1, 1), Cells(1, 2).End(xlDown))
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    count = 0
    Data = ""
    Value = ""
    v = 0
    dROW = 1
    For x = 1 To 6
        Cells(1, x + 2) = Choose(x, "Data", "Count", "Value 1", "Value 2", "Value 3", "Value 4")
    Next x
    For Each rg In Range(Cells(2, 1), Cells(2, 1).End(xlDown))
        If Cells(rg.Row, 1) = Data Then
            count = count + 1
            If Cells(rg.Row, 2) <> Value Then
                Value = Cells(rg.Row, 2)
                Cells(dROW, 4 + v) = Cells(rg.Row, 2)
                v = v + 1
            End If
            Cells(dROW, 4) = count
       Else
            Data = Cells(rg.Row, 1)
            Value = Cells(rg.Row, 2)
            dROW = dROW + 1
            Cells(dROW, 3) = Data
            Cells(dROW, 4) = 1
            Cells(dROW, 5) = Value
            count = 1
            v = 2
        End If
    Next rg
    Range(Cells(1, 1), Cells(1, 2).End(xlDown)).Delete Shift:=xlToLeft
    Range("A1").Select
End Sub
 
Inspired by byundt's very clever (but also very complex) formula, I set out to come up with an approach that:
(1) Avoids the need manually to run a macro or update a pivot table to refresh the results; and
(2) Works under earlier versions of Excel than 2007.

The result is attached. It requires the use of a user-defined array function I have called Remove_Dups, which I wrote many years ago to solve a similar problem. This function creates the "count table" that in byundt's spreadsheet is created as a pivot table.

To get it to work under earlier versions of Excel I had to remove the use of "tables". I also had to remove the IFERROR() function from byundt's array formula. This means that the "empty" portions of the right-hand part of the results table fill with #NUM! values. To lessen the visual distraction of these I used conditional formatting, based on a formula =ISERROR(cell), formatting the cell's text in pale grey if the formula is true. Use white for the cell's text to make the error messages completely invisible.

If working with Excel 207 or later, the IFERROR() can be replaced and the conditional formatting can be removed.

It could be tarted up no end, including the use of dynamic named arrays as a substitute for Excel's "tables", but I haven't done this.

 
 http://files.engineering.com/getfile.aspx?folder=ef102ae3-c27d-40e2-8278-9339f5a66ab6&file=TekTips_ListSummariser.xls
If you are using Excel 2003 or earlier, then you can use this array-entered formula:
=IF(COLUMNS($G2:G2)>$F2,"",INDEX($B$2:$B$14,SMALL(IF($A$2:$A$14=$E2,ROW($A$2:$A$14)-1,""),COLUMNS($G2:G2))))

It assumes a layout exactly the same as in the workbook I previously posted:
1. A two-columns table of data in A1:B14, with header labels in row 1
2. A PivotTable in E1:F11
3. Formula goes in cell G2, and then copied down and across

This formula will return an empty string (looks like a blank) when the Values have been exhausted for the given Data.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top