Common Data Values !!!

[G21]

HI ,
I'm having a requirement to arrange the sheet according to the available common data.
eg-
A X
A Y
A Z
B X
B Z

so i need to arrange this in a different sheet according to this pattern ...

A X Y Z
B X Z

Can someone help me on this ...

RGDS
G

 

[Trouttrap2]

Right, Assuming your data are in columns A and B....

Enter A in D1
Enter B in D2
then enter =IF(COLUMNS($E1:E1)<=COUNTIF($A$1:$A$5,$D1),INDEX($B$1:$B$5,SMALL(IF($D1=$A$1:$A$5,ROW($A$1:$A$5)-ROW($A$1)+1),COLUMNS($E1:E1))),"") into column E1.
Drag down then to the right for both of your lookup values that are in cells D1 and D2. D1 is your 'A' lookup and D2 is your 'B' lookup.

This is an array formula, so CTRL+SHIFT+ENTER, not just enter.

 

[jim may]

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	A	X		A	X	Y	Z		<<< These are Control-Array Formulas
2	A	Y		B	X	Z			<<< These are Control-Array Formulas
3	A	Z
4	B	X
5	B	Z
Sheet1

Excel 2007

#VALUE!

Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.

 

[hiker95]

G21,


Sample raw data in worksheet Sheet1 (without titles in row 1):

Excel Workbook
	A	B
1	A	X
2	A	Y
3	A	Z
4	B	X
5	B	Z
6
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C	D
1	A	X	Y	Z
2	B	X	Z
3
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgData()
' hiker95, 03/15/2011
' http://www.mrexcel.com/forum/showthread.php?t=536350
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, SR As Long, ER As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
Set wR = Worksheets("Results")
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
w1.Range("A1:B" & LR).Sort Key1:=w1.Range("A1"), Order1:=xlAscending, Key2:=w1.Range("B1") _
  , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
  False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
w1.Rows(1).Insert
w1.Range("A1") = "Test"
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(1), Unique:=True
w1.Rows(1).Delete
wR.Rows(1).Delete
LR = wR.Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To LR Step 1
  SR = Application.Match(wR.Cells(a, 1), w1.Columns(1), 0)
  ER = Application.Match(wR.Cells(a, 1), w1.Columns(1), 1)
  wR.Range("B" & a).Resize(, ER - SR + 1).Value = Application.Transpose(w1.Range("B" & SR & ":B" & ER))
Next a
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[G21]

Hi,
<br><br>Trouttrap2 - I do not get the required output from your answer.<br><br>jim may - Actually i don't get the point which you describe. whats the control array formula you refer.<br><br>hiker95 - Your code works for the given data.But it has some issues when i have more data with different categories. <br>eg- if sheet1<br><br>A    X<br>A    Y<br>A    Z<br>B    X<br>B    y<br>B    Z<br>C    T<br>C    W<br>C    x<br><br>then the Result  will be  like ,<br><br>A    X    Y    Z<br>B    X    y    Z<br>C    T    W    x<br><br>* its ok even if  can  select   what  i  need from that, mean X Y  &  Z to the result. If  not each column should contain similar  categories.<br><br>A               X    Y    Z<br>B               X    y    Z<br>C   W    T   X       <br><br><br>Thanks every  one for your  support <img smilieid="1" class="inlineimg" src="http://www.mrexcel.com/forum/images/smilies/icon_smile.gif" border="0"><br><br>RGDS<br>G<br><br><br><br><br>

 

[hiker95]

G21,


Sample raw data in worksheet Sheet1:

Excel Workbook
	A	B
1	A	X
2	A	Y
3	A	Z
4	B	X
5	B	Y
6	B	Z
7	C	T
8	C	W
9	C	x
10
Sheet1

After the macro in a new worksheet Results:

Excel Workbook
	A	B	C	D	E	F
1	A			X	Y	Z
2	B			X	Y	Z
3	C	T	W	x
4
Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).


1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub ReorgDataV2()
' hiker95, 03/17/2011
' http://www.mrexcel.com/forum/showthread.php?t=536350
Dim w1 As Worksheet, wR As Worksheet
Dim LR As Long, a As Long, aa As Long, SR As Long, ER As Long, FC As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
Set wR = Worksheets("Results")
LR = w1.Cells(Rows.Count, 1).End(xlUp).Row
w1.Range("A1:B" & LR).Sort Key1:=w1.Range("A1"), Order1:=xlAscending, Key2:=w1.Range("B1") _
  , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
  False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
w1.Rows(1).Insert
w1.Range("A1:B1") = [{"TestA","TestB"}]
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(1), Unique:=True
w1.Columns(2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wR.Columns(2), Unique:=True
w1.Rows(1).Delete
LR = wR.Cells(Rows.Count, 2).End(xlUp).Row
wR.Range("B2:B" & LR).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
wR.Range("A1:B1").ClearContents
wR.Range("B1").Resize(, LR - 2 + 1).Value = Application.Transpose(wR.Range("B2:B" & LR).Value)
wR.Range("B2:B6").ClearContents
LR = wR.Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To LR Step 1
  SR = Application.Match(wR.Cells(a, 1), w1.Columns(1), 0)
  ER = Application.Match(wR.Cells(a, 1), w1.Columns(1), 1)
  For aa = SR To ER Step 1
    FC = Application.Match(w1.Cells(aa, 2), wR.Rows(1), 0)
    wR.Cells(a, FC).Value = w1.Cells(aa, 2).Value
  Next aa
Next a
wR.Rows(1).Delete
wR.Activate
Application.ScreenUpdating = True
End Sub

Then run the ReorgDataV2 macro.

 

[G21]

HI hiker95,
getting run time 1004 in below mentioned,

wR.Range("B2:B" & LR).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

RGDS,
G

 

[facethegod]

With your input in A1:B9

Try this in D1 down

=IF(ROWS($A$1:A1)>SUMPRODUCT(($A$1:$A$9<>"")/COUNTIF($A$1:$A$9,$A$1:$A$9)),"",INDEX($A$1:$A$9,SMALL(IF(ISNUMBER(MATCH(ROW($A$1:$A$9)-ROW(A1)+1,MATCH($A$1:$A$9,$A$1:$A$9,0),0)),ROW($A$1:$A$9)-ROW(A1)+1),ROWS($A$1:A1))))

Try this in E1 across & then down

=IF(COLUMNS($A1:A1)>COUNTIF($A$1:$A$9,$D1),"",INDEX($B$1:$B$9,SMALL(IF($A$1:$A$9=$D1,ROW($A$1:$A$9)-ROW($A$1)+1),COLUMNS($A1:A1))))


These are array formula's so you must confirm with Control+Shift+Enter, not just Enter

Hope this helps

 

[hiker95]

G21,

Try:

wR.Range("B2:B" & LR).Sort Key1:=[B]wR.[/B]Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal