Advanced transpose/grouping question

K

KIM W

Don't hesitated to say this is too much for a forum question....

I am attempting to place a series of values from a column into rows, but the
details of this task are much more than typical transpose. I have played
with formulas, MATCH, OFFSET, etc. and got tangled up. That still my be good
way to go.

Here bleow is DATA is in COL A and B. Output starts in COL C and continues
across as many columns as needed. When values repeat in A, transpose the
values from COL B for that repeated COL A value starting at COL C through
possibly 100 columns, i.e. COL A value could repeat 100 times. It is
important to note that in a grouping of repeaded rows (defined by repeating
value in COL A), the resulting transposed values from COL B repeat down for
each repeated row. This is why all the rows of data for the f's are the
same-- this is intentional. In other words, transpose all the values in COL
B for a group of repeating values in A, and transpose across the row
containing first value of COL A, the fill down identically for all COL A
group.
Why am I attempting this? It is to identify identical groupings of values,
e.g. somewhere else in the list there will be another group of rows, say 4
rows with "z" in COl A, and those four rows have the same values as found in
COL B, therefore one can say group f and group z are identical-- a list of
identical groups is the objective. There may be several identical
groupings, not just two. ALternatives are welcome. (In my soloution I expect
to concatenate the values in COL C... and sort on that concatenation, then
subtotal/count.)
COL A COLB COL C COL D COL E COL F COL G
a kk kk
b mm mm
c mm mm
d nn nn pp
d pp nn pp
e qq qq
f rr rr ss tt uu
f ss rr ss tt uu
f tt rr ss tt uu
f uu rr ss tt uu
g xx
 
R

Rick Rothstein

I think this macro will do what you want (set the DataStartRow constant as
required)...

Sub TransposeDuplicates()
Dim X As Long, StartRow As Long, LastRow As Long, HowMany As Long
Const DataStartRow As Long = 2
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
HowMany = 1
For X = DataStartRow To LastRow
If HowMany = 1 Then
StartRow = X
Do While Cells(X + HowMany - 1, "A").Value = _
Cells(X + HowMany, "A").Value
HowMany = HowMany + 1
Loop
End If
Cells(X, "C").Resize(, HowMany) = WorksheetFunction.Transpose( _
Cells(StartRow, "B").Resize(HowMany))
If X = StartRow + HowMany - 1 Then HowMany = 1
Next
End Sub
 
P

Per Jessen

Hi

I think this is what you need, just remember that a heading is required in
A1:

Sub MyTranspose()
Dim FilterRange As Range
Dim DataRange As Range
Dim UniqueArray()
'For filter purpose a Heading is needed in A1

LastRow = Range("A1").End(xlDown).Row
Application.ScreenUpdating = False
Set FilterRange = Range("A1:A" & LastRow)
Set DataRange = Range("B2:B" & LastRow)
FilterRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
UniqueVal = Array(FilterRange.SpecialCells(xlCellTypeVisible))
ReDim UniqueArray(FilterRange.SpecialCells(xlCellTypeVisible).Count - 1)
For Each cell In FilterRange.SpecialCells(xlCellTypeVisible)
UniqueArray(c) = cell.Value
c = c + 1
Next
ActiveSheet.ShowAllData

For c = 1 To UBound(UniqueArray)
FilterRange.AutoFilter Field:=1, Criteria1:=UniqueArray(c)
DataRange.SpecialCells(xlCellTypeVisible).Copy
DataRange.SpecialCells(xlCellTypeVisible).Offset(0, 1).PasteSpecial _
Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next
FilterRange.AutoFilter
Application.ScreenUpdating = True
End Sub

Regards,
Per
 
R

Rick Rothstein

Just so you don't confuse requirements, I wanted to point out that Per's
solution and mine are totally different... with mine, the DataStartRow can
be in Row 1, in case you need that, and it can just as easily be Row 100 as
the code will adjust around it automatically (I just used an example
DataStartRow of 2 making the assumption that your data might have a header
row).
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top