# Common Data Values !!!

#### G21

##### New Member
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

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
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.

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 {}.

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
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
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.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.

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>

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
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
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.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.

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

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

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``````

Replies
2
Views
173
Replies
15
Views
437
Replies
4
Views
634
Replies
2
Views
244
Replies
6
Views
228

1,221,062
Messages
6,157,691
Members
451,434
Latest member
VanDookie

### 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.

### Which adblocker are you using?

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

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