Common Data Values !!!

G21

New Member
Joined
Oct 17, 2010
Messages
26
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
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
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.
 
Upvote 0
Excel Workbook
ABCDEFGHI
1AXAXYZ<<< These are Control-Array Formulas
2AYBXZ<<< These are Control-Array Formulas
3AZ
4BX
5BZ
Sheet1
Excel 2007
#VALUE!
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
 
Upvote 0
G21,


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


Excel Workbook
AB
1AX
2AY
3AZ
4BX
5BZ
6
Sheet1





After the macro in a new worksheet Results:


Excel Workbook
ABCD
1AXYZ
2BXZ
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.


Code:
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.
 
Upvote 0
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>
 
Upvote 0
G21,


Sample raw data in worksheet Sheet1:


Excel Workbook
AB
1AX
2AY
3AZ
4BX
5BY
6BZ
7CT
8CW
9Cx
10
Sheet1





After the macro in a new worksheet Results:


Excel Workbook
ABCDEF
1AXYZ
2BXYZ
3CTWx
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.


Code:
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.
 
Upvote 0
HI hiker95,
getting run time 1004 in below mentioned,

Code:
wR.Range("B2:B" & LR).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
  OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
RGDS,
G
 
Upvote 0
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
 
Upvote 0
G21,

Try:

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

Forum statistics

Threads
1,213,530
Messages
6,114,163
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top