Data Arranging

K

Karan001

Board Regular
Joined
Jul 22, 2009
Messages
113
Hi Experts,
I have huge data as given below in TABLE-1.I want a way so that the data can be arrange as shown in TABLE-2.

TABLE-1
<table border="0" cellpadding="0" cellspacing="0" width="417"><col style="width: 123pt;" width="164"> <col style="width: 190pt;" width="253"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl68" style="height: 12.75pt; width: 123pt;" height="17" width="164">DATA1</td> <td class="xl68" style="border-left: medium none; width: 190pt;" width="253">DATA2</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-1</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">BLACK</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-1</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">GREEN</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-1</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">RED</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; border-top: medium none;" height="17">SUB-2</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">BLACK</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; border-top: medium none;" height="17">SUB-2</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">GREEN</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; border-top: medium none;" height="17">SUB-2</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">RED</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl66" style="height: 12.75pt; border-top: medium none;" height="17">SUB-2</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">YELLOW</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-3</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">BLACK</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-3</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">GREEN</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-3</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">RED</td> </tr> </tbody></table>

TABLE-2

<table border="0" cellpadding="0" cellspacing="0" width="653"><col style="width: 123pt;" width="164"> <col style="width: 190pt;" width="253"> <col style="width: 83pt;" width="110"> <col style="width: 47pt;" width="62"> <col style="width: 48pt;" width="64"> <tbody><tr style="height: 12.75pt;" height="17"> <td class="xl69" style="height: 12.75pt; width: 123pt;" height="17" width="164">DATA1</td> <td class="xl69" style="border-left: medium none; width: 190pt;" width="253">DATA2</td> <td class="xl69" style="border-left: medium none; width: 83pt;" width="110">DATA3</td> <td class="xl69" style="border-left: medium none; width: 47pt;" width="62">DATA4</td> <td class="xl69" style="border-left: medium none; width: 48pt;" width="64"> DATA5</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl68" style="height: 12.75pt; border-top: medium none;" height="17">SUB-1</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">BLACK</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">GREEN</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">RED</td> <td class="xl65" style="border-top: medium none; border-left: medium none;">
</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl67" style="height: 12.75pt; border-top: medium none;" height="17">SUB-2</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">BLACK</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">GREEN</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">RED</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">YELLOW</td> </tr> <tr style="height: 12.75pt;" height="17"> <td class="xl68" style="height: 12.75pt; border-top: medium none;" height="17">SUB-3</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">BLACK</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">GREEN</td> <td class="xl66" style="border-top: medium none; border-left: medium none;">RED</td> <td>
</td> </tr> </tbody></table>

Here in want whatever repeat data of table 1 in data-1 column should come in Tabular form as shown in table-2





Hi Peter,
I am facing a small problem while using the code given by you.The problem is in column nearly thousands of rows are there but if i am using the codes then it is arranging only data for few rows only and other value in column is get skipped.
Please tell me how to modify the code so that it will consider the all the value inside coulmn.
Code :-


Sub MakeTable()
Dim LastRow As Long, i As Long, Area As Range
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
If Range("A" & i).Value <> Range("A" & i - 1).Value Then
Rows(i).Insert
End If
Next i
For Each Area In Columns("A").SpecialCells(xlCellTypeConstants).Areas
Area(1).Offset(, 1).Resize(, Area.Rows.Count).Value = Application.Transpose(Area.Offset(, 1))
Next Area
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub</pre>






Regards,
Karan
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
I think there is a limit of about 8000 areas (SUB-* in your example). I think you'd need to split your data into smaller chunks (sheets), run the macro on each then recombine them.
 
Upvote 0
Hi Peter,
Once again thanks for the reply.Actually the system only clubs wherever the repeated value in the column.Unique data system exclude from the report.I got now and your solution is giving excellent support to me.


Regards,

Karan
 
Upvote 0
Karan001,


Sample data (with the data sorted/grouped per your screenshot) before the macro:


Excel Workbook
AB
1DATA1DATA2
2SUB-1BLACK
3SUB-1GREEN
4SUB-1RED
5SUB-2BLACK
6SUB-2GREEN
7SUB-2RED
8SUB-2YELLOW
9SUB-3BLACK
10SUB-3GREEN
11SUB-3RED
12
TABLE-1





After the macro in a new worksheet TABLE-2:


Excel Workbook
ABCDE
1DATA1DATA2DATA3DATA4DATA5
2SUB-1BLACKGREENRED
3SUB-2BLACKGREENREDYELLOW
4SUB-3BLACKGREENRED
5
TABLE-2





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, 05/13/2011
' http://www.mrexcel.com/forum/showthread.php?t=549830
Dim w1 As Worksheet, w2 As Worksheet
Dim LR As Long, a As Long, aa As Long, SR As Long, ER As Long, FC As Long, LC As Long
Application.ScreenUpdating = False
Set w1 = Worksheets("TABLE-1")
If Not Evaluate("ISREF('TABLE-2'!A1)") Then Worksheets.Add(After:=w1).Name = "TABLE-2"
Set w2 = Worksheets("TABLE-2")
w2.UsedRange.Clear
w1.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=w2.Columns(1), Unique:=True
w1.Columns(2).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=w2.Columns(2), Unique:=True
LR = w2.Cells(Rows.Count, 2).End(xlUp).Row
w2.Range("B1").Resize(, LR - 1).Value = Application.Transpose(w2.Range("B2:B" & LR))
w2.Range("B2").Resize(LR).ClearContents
LR = w2.Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To LR Step 1
  SR = Application.Match(w2.Cells(a, 1), w1.Columns(1), 0)
  ER = Application.Match(w2.Cells(a, 1), w1.Columns(1), 1)
  For aa = SR To ER Step 1
    FC = 0
    On Error Resume Next
    FC = Application.Match(w1.Cells(aa, 2), w2.Rows(1), 0)
    On Error GoTo 0
    If FC <> 0 Then
      w2.Cells(a, FC).Value = w1.Cells(aa, 2).Value
    End If
  Next aa
Next a
LC = w2.Cells(1, Columns.Count).End(xlToLeft).Column
With w2.Cells(1, 2).Resize(, LC - 1)
  .Formula = "=""DATA""&COLUMN()"
  .Font.Bold = True
  .Value = .Value
End With
w2.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub


Then run the ReorgData macro.


If your data does not match my screenshots, then:

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:
 
Upvote 0
Hi Hiker,
The data-2 is in cell B1. But when i am using the code provided this giving error after following the steps given by you.Please can u check the codes once again it is giving end code erro "9".

Actually i got the solution given by the peter it is just for your information.Please check your codes also may be it will give some more helpful.Because only if i have more data then may be i can used your codes as mentioned by Peter above.



Regards,
Karan
 
Upvote 0
Karan001,

My code works correctly for the raw data that I displayed above.

If the code is not working correctly with your actual dataset, then we need to see your actual data.

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (what you have and what you expect to achieve) directly in the forum (sensative information changed).

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net
 
Upvote 0
Hi Hiker,
I used the sam data which you have in the forum.Please see below.
<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial, Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>A</TD><TD>B</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="FONT-WEIGHT: bold">DATA1</TD><TD style="FONT-WEIGHT: bold">DATA2</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD>SUB-1</TD><TD>BLACK</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD>SUB-1</TD><TD>GREEN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD>SUB-1</TD><TD>RED</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD>SUB-2</TD><TD>BLACK</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD>SUB-2</TD><TD>GREEN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD>SUB-2</TD><TD>RED</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD>SUB-2</TD><TD>YELLOW</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD>SUB-3</TD><TD>BLACK</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD>SUB-3</TD><TD>GREEN</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD>SUB-3</TD><TD>RED</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD></TD><TD></TD></TR></TBODY></TABLE>




Data-1 is in A1 Data-2 is in B1


I am getting i small pop window
errro is
" Run time error '9'
subscript out of range".

If i am debugging it takes me in code are and cursor highlighted this line in codes

Set w1 = Worksheets("TABLE-1")

Please let me know where i am doing the mistake.


Regards,
Karan
 
Last edited:
Upvote 0
Karan001,

Set w1 = Worksheets("TABLE-1")
Click to expand...


Is the worksheet name TABLE-1 ?

Or, are TABLE-1 and TABLE-2 range names?


What is the worksheet name where the raw data is?
 
Upvote 0
Hi Karan,

Try

Code: 
Sub kTest()
    Dim ka, k(), i As Long, n As Long, dic As Object, d, eCol   As Long
    
    With Application
        .ScreenUpdating = 0
        .DisplayAlerts = 0
    End With
    ka = ActiveSheet.UsedRange.Resize(, 2)
    
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    ReDim k(1 To UBound(ka, 1), 1 To 100)
    For i = 2 To UBound(ka, 1)
        If Len(ka(i, 1)) Then
            If Not dic.exists(ka(i, 1)) Then
                n = n + 1
                k(n, 1) = ka(i, 1): k(n, 2) = ka(i, 2)
                dic.Add ka(i, 1), Array(n, 2)
            Else
                d = dic.Item(ka(i, 1))
                d(1) = d(1) + 1
                eCol = Application.Max(eCol, d(1))
                k(d(0), d(1)) = ka(i, 2)
                dic.Item(ka(i, 1)) = d
            End If
        End If
    Next
    
    On Error Resume Next
    Worksheets("_Summary").Delete
    On Error GoTo 0
    Worksheets.Add
    ActiveSheet.Name = "_Summary"
    With Range("a1")
        For i = 1 To eCol
            .Offset(, i - 1).Value = "Data" & i
        Next
        .Offset(1).Resize(n, eCol).Value = k
    End With
    With Application
        .ScreenUpdating = 1
        .DisplayAlerts = 1
    End With

End Sub

HTH
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
617
smozgur
smozgur
P
  • Question Question
Select the time from the list and search with Selenium VBA
Replies
6
Views
614
John_w
J
E
  • Question Question
VBA code clean up
Replies
9
Views
573
mumps
mumps
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
920
epactheactor
E

Forum statistics

Threads
1,224,524
Messages
6,179,308
Members
452,904
Latest member
CodeMasterX

Share this page

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