Match cells in column, then transpose matching row data from column b, c etc on many

A

arcadian13

New Member
Joined
Jul 23, 2012
Messages
22
I have a spreadsheet with multiple tabs, and would like to transpose the data on each tab in the way described below:

So if I have:
1 a
1 b
1 c
2 a
2 c
2 d

I would like to get

1 a b c
2 a c d

Same with multicolumn. if I have

1 a b c
1 d
2 e f g h
2 i j

Would like to get

1 a b c d
2 e f g h i j

Am a coding dummy, so appreciate any help
 
Sort by date Sort by votes
Are you sure thats the Tab, this is what was returned when I ran the code on it !!!
[TABLE="width: 574"]
<COLGROUP><COL style="WIDTH: 40pt; mso-width-source: userset; mso-width-alt: 1877" width=53><COL style="WIDTH: 534pt; mso-width-source: userset; mso-width-alt: 25315" width=712><TBODY>[TR]
[TD="class: xl22, width: 53, bgcolor: transparent"]User[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Job title_Job description_Date from_Date to_Company name_About company_Company url_Location_Reference name_Reference number_Reference email)[/TD]
[/TR]
[TR]
[TD="class: xl23, width: 53, bgcolor: transparent"]1[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Title__24/06/2012_23/08/2012_Rest),(Fugfg____Test),(Profesor_Opasan posoa_24/07/2008_24/07/2011_Pros__http://skola.com__sko11_1123_tg@cc.com),(Tytt____Test),(Test____Test)[/TD]
[/TR]
[TR]
[TD="class: xl23, width: 53, bgcolor: transparent"]12[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Web Designer_Web and graphic designer._20/08/2011__Eton Digital__http://etondigital.com_Novi Sad, Autonomna Pokrajina Vojvodina, Serbia___info@etondigital.com)[/TD]
[/TR]
[TR]
[TD="class: xl23, width: 53, bgcolor: transparent"]74[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Director_Students can use WCS from day 1, year 1 of their university career to create a professional profile and expose themselves to employers._07/08/2010__We Connect Students_A revolutionary recruitment portal that enables students and employers to connect._http://weconnectstudents.com_London, England, United Kingdom_Clive Banks_7920000000_clive@weconnectstudents.com),(Founder_We Connect Students is the new online social community which places students in the centre of a well-connected, professional environment of employers and industry mentors looking to identify and attract graduate talent._04/03/2008_07/08/2010_We Connect Students_A powerful search enables students to be found by the right employer for the right job._http://weconnectstudents.com_Beccles, England, United Kingdom)[/TD]
[/TR]
[TR]
[/TR]
[TR]
[TD="class: xl23, width: 53, bgcolor: transparent"]75[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Intern_Placement as part of my degree. Worked in all hotel areas, from Maintenance to Evening Host._06/06/2011_06/06/2012_Manor on Golden Pond_The Manor has 24 guest bedrooms, a spa, tennis court and a heated outdoor swimming pool. The hotel is AAA 4 diamond and is also a member of Small Luxury Hotels and Wine Spectator._http://www.manorongoldenpond.com_Holderness, New Hampshire, United States_Brian Shields__brianps@roadrunnner.com)[/TD]
[/TR]
[TR]
[TD="class: xl23, width: 53, bgcolor: transparent"]95[/TD]
[TD="class: xl22, width: 712, bgcolor: transparent"](Public Relations Officer_Designing and publishing material for the public._03/01/2011_06/01/2011_United Kingdom Atomic Energy Authority_Leading research company in UK and Europe for Nuclear Fusion based power._http://www.ccfe.ac.uk_Culham, England, United Kingdom_Chris Warrick__chris.warrick@ccfe.ac.uk),(Sales and Marketing Team Leader_Planning, managing and carrying out a large scale marketing campaign._26/01/2012__We Connect Students_Online social community, putting students into the centre of a well connected system of companies who are looking for prospective graduates to employ._http://www.weconnectstudents.com__Oliver ****inson__oliver@weconnectstudents.com),(Intern_Shadowing and administrative work with additional research into investments and presentations to the heads of department summarising my findings._01/06/2006_01/07/2006_Prudential Assurance_Prudential plc is an international financial services group with significant operations in Asia, the US and the UK_http://www.prudential.co.uk_London, England, United Kingdom)[/TD]
[/TR]
</TBODY>[/TABLE]
 
Upvote 0

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
Am puzzled, because what you have is exactly the output I want. I tried it again, and got the same error, and the tabs after the one with the error remained unsorted. Hmmm. Any suggestions more than welcome. If you can let me send you the test workbook I am getting the error on, it might be useful
 
Upvote 0
What happens if you islolate that sheet in a new workbook and try running the code on it.
Failing that:-
Can you send the file via a file sharing site, like "4shared.com" or similar.
NB:- please send with ".xls" extension.
 
Upvote 0
I have been doing exactly that (isolating that tab in a new workbook) and it sorts as I want it to. When I added other tabs, it continued to sort fine. Will share the test sheet which still causes an error with mutliple tabs as .xls via 4shared.com
 
Upvote 0
When you say "Text" string, can you give me a cell number in the test sheet as an example? Do you mean something like C9 in "work experience"? I thought each cell could have a large number of entries (37,000?). I am trying to see if there is any kind of limit for my users on the field which I can tell you about.

BTW is it also possible to have all the cells with unwrapped text after the sort (in all of the tabs)
 
Upvote 0
When you try to add text in a cell using a string variable you run in to the problem of 255 characters being the linit , so you have to find a work around.
Try this:-
NB:- ther is no word wrap in the code.
Code: 
[COLOR=navy]Sub[/COLOR] MG27Jul57
'[COLOR=green][B]New Code[/B][/COLOR]
[COLOR=navy]Dim[/COLOR] Rng         [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn          [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Lst         [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] nRng        [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Q
[COLOR=navy]Dim[/COLOR] n           [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ws          [COLOR=navy]As[/COLOR] Worksheet
[COLOR=navy]Dim[/COLOR] Ac          [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Ray
[COLOR=navy]Dim[/COLOR] ColMax      [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] k
[COLOR=navy]Dim[/COLOR] Wd
[COLOR=navy]Dim[/COLOR] tx
Application.ScreenUpdating = False
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Ws [COLOR=navy]In[/COLOR] ActiveWorkbook.Worksheets
    
    [COLOR=navy]If[/COLOR] Not Ws.Name = "users" [COLOR=navy]Then[/COLOR]
        [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
            .comparemode = vbTextCompare
[COLOR=navy]Set[/COLOR] Rng = Ws.Range(Ws.Range("A1"), Ws.Range("A" & Rows.Count).End(xlUp))
    ReDim Ray(1 To Rng.Count, 1 To 2)
        [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
            [COLOR=navy]If[/COLOR] Dn > "" [COLOR=navy]Then[/COLOR]
        Lst = Ws.Cells(Dn.Row, Columns.Count).End(xlToLeft).Column
         ColMax = Application.Max(ColMax, Lst)
            [COLOR=navy]If[/COLOR] Not .exists(Dn.Value) [COLOR=navy]Then[/COLOR]
                    Ray(1, 1) = Ws.Range(Dn.Offset(, 1), Ws.Cells(Dn.Row, Columns.Count).End(xlToLeft))
                    Ray(1, 2) = Lst
                    .Add Dn.Value, Array(Dn.Offset(, 1), Ray, 1, Lst)
                [COLOR=navy]Else[/COLOR]
                    Q = .Item(Dn.Value)
                        Q(2) = Q(2) + 1
                        Q(1)(Q(2), 1) = Ws.Range(Dn.Offset(, 1), Ws.Cells(Dn.Row, Columns.Count).End(xlToLeft))
                        Q(1)(Q(2), 2) = Lst
                        
                        [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
                            [COLOR=navy]Set[/COLOR] nRng = Dn
                        [COLOR=navy]Else[/COLOR]
                            [COLOR=navy]Set[/COLOR] nRng = Union(nRng, Dn)
                        [COLOR=navy]End[/COLOR] If
                    .Item(Dn.Value) = Q
                [COLOR=navy]End[/COLOR] If
            [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR]
'[COLOR=green][B]K = Each unique col "A"[/B][/COLOR]
 [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] k [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]If[/COLOR] .Item(k)(3) > 1 And Not Left(.Item(k)(0), 1) = "(" [COLOR=navy]Then[/COLOR]
        .Item(k)(0).Value = vbNullString
        '[COLOR=green][B]tx = the number of rows for any one unique[/B][/COLOR]
        [COLOR=navy]For[/COLOR] tx = 1 To .Item(k)(2)
             
             [COLOR=navy]If[/COLOR] .Item(k)(1)(tx, 2) = 2 [COLOR=navy]Then[/COLOR]
              .Item(k)(0).Value = .Item(k)(0).Value & "(" & .Item(k)(1)(tx, 1) & "),"
            [COLOR=navy]Else[/COLOR]
            '[COLOR=green][B]Ac = number of columns in each row for each unique[/B][/COLOR]
                [COLOR=navy]For[/COLOR] Ac = 1 To .Item(k)(1)(tx, 2) - 1
                   [COLOR=navy]If[/COLOR] Not .Item(k)(1)(tx, 1)(1, Ac) = vbNullString [COLOR=navy]Then[/COLOR]
                        Wd = Split(.Item(k)(1)(tx, 1)(1, Ac), " ")
                            [COLOR=navy]For[/COLOR] n = 0 To UBound(Wd)
                                [COLOR=navy]If[/COLOR] Ac = 1 [COLOR=navy]Then[/COLOR]
                                    .Item(k)(0).Value = .Item(k)(0).Value & "(" & Wd(n)  '[COLOR=green][B].Item(k)(1)(tx)(1, Ac)[/B][/COLOR]
                                [COLOR=navy]Else[/COLOR]
                                    .Item(k)(0).Value = .Item(k)(0).Value & "_" & Wd(n) '[COLOR=green][B].Item(k)(1)(tx)(1, Ac)[/B][/COLOR]
                                [COLOR=navy]End[/COLOR] If
                             [COLOR=navy]Next[/COLOR] n
                    [COLOR=navy]End[/COLOR] If
                 [COLOR=navy]Next[/COLOR] Ac
            .Item(k)(0).Value = .Item(k)(0).Value & "),"
        [COLOR=navy]End[/COLOR] If
        [COLOR=navy]Next[/COLOR] tx
  [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] k
.RemoveAll
[COLOR=navy]End[/COLOR] With
 
 [COLOR=navy]If[/COLOR] Not nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] nRng.EntireRow.Delete
   [COLOR=navy]Set[/COLOR] nRng = Nothing
    Lst = 0
[COLOR=navy]End[/COLOR] If
        [COLOR=navy]If[/COLOR] ColMax > 0 [COLOR=navy]Then[/COLOR] Ws.Columns("C:C").Resize(, ColMax).ClearContents
    ColMax = 0
[COLOR=navy]Next[/COLOR] Ws
Application.ScreenUpdating = True
MsgBox "Run !!"
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Matching two columns cell for cell
Replies
2
Views
142
jolivanes
jolivanes
C
  • Solved
Transposing Columns to Rows
2
Replies
10
Views
194
Fluff
Fluff
R
  • Question Question
How to copy a range of data if two cells match
Replies
2
Views
249
rockychelsea
R
R
  • Solved
How to independently sort multiple columns of this SEQUENCE output without effecting the positions of the columns and of the blanks?
2
Replies
15
Views
459
Rnkhch
R
E
  • Solved
Looking for a spilled formula returning the value in a table matching 3 conditions
Replies
5
Views
137
ED38
E

Forum statistics

Threads
1,223,243
Messages
6,170,964
Members
452,371
Latest member
Frana

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