Unusual de-dupe question

[Chartman of the Bored]

I have some rows of data with a bunch of duplicate text strings, like this (each fruit is in a separate cell):

Company ABC Apples Oranges Lemons Lemons Lemons Pears
Company DEF Orange Lemons Pears Pears Pears Pears Pears Cucumbers
Company XYZ Apples Apples Apples Pears Pears Lemons Lemons Lemons Lemons Lemons


I'm trying to de-dupe them. I can do it one row at a time (or one column at a time if I transpose) using Excel's "Consolidate" feature. But I have 2,000+ rows. I can't do them one at a time without spending endless hours of monotony.

Is there a way to do this (ideally without VBA)? I would theoretically want the data above to like like this (with one instance of each fruit instead of multiple):

Company ABC Apples Oranges Lemons Pears
Company DEF Orange Lemons Pears Cucumbers
Company XYZ Apples Pears Lemons


Thanks very much

 

[Takae]

A2 of sheet1 has first data(Company ABC).
B2 of sheet2 = =IFERROR(IF(ROW($A$1)>SUMPRODUCT((OFFSET(Sheet1!$B2,0,0,1,COUNTA(Sheet1!2:2)-1)<>"")/COUNTIF(OFFSET(Sheet1!$B2,0,0,1,COUNTA(Sheet1!2:2)-1),OFFSET(Sheet1!$B2,0,0,1,COUNTA(Sheet1!2:2)-1)&""))-1,"",INDEX(OFFSET(Sheet1!$B2,0,0,1,COUNTA(Sheet1!2:2)-1),MATCH(0,INDEX(0/ISERROR(MATCH(OFFSET(Sheet1!$B2,0,0,1,COUNTA(Sheet1!2:2)-1),$A2:A2,0)),),0))),"")

VBA

Sub frt()
Dim i As Long, j As Long, LC As Long
Dim rng As Range, Dic, x, C, buf
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Sheets("sheet1")
Set ws2 = Sheets("sheet2")
With ws1
    For i = 2 To .cells(Rows.count, 1).End(xlUp).row
    Set Dic = CreateObject("scripting.Dictionary")
    On Error Resume Next
        LC = .cells(i, Columns.count).End(xlToLeft).column
        For Each C In .Range(.cells(i, 1), .cells(i, LC))
            buf = C.Value
            Dic.Add buf, buf
        Next
        x = Dic.keys
        ws2.Range(ws2.cells(i, 1), ws2.cells(i, UBound(x) + 1)) = x
    Next
End With
Set Dic = Nothing
End Sub

 

[Aladin Akyurek]

[Table="width:, class:grid"][tr][td]Row\Col[/td][td]

A​

[/td][td]

B​

[/td][td]

C​

[/td][td]

D​

[/td][td]

E​

[/td][td]

F​

[/td][td]

G​

[/td][td]

H​

[/td][td]

I​

[/td][td]

J​

[/td][td]

K​

[/td][/tr][tr][td]

1​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

2​

[/td][td]ABC[/td][td]Apples[/td][td]Oranges[/td][td]Lemons[/td][td]Lemons[/td][td]Lemons[/td][td]Pears[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

3​

[/td][td]DEF[/td][td]Orange[/td][td]Lemons[/td][td]Pears[/td][td]Pears[/td][td]Pears[/td][td]Pears[/td][td]Pears[/td][td]Cucumbers[/td][td][/td][td][/td][/tr]
[tr][td]

4​

[/td][td]XYZ[/td][td]Apples[/td][td]Apples[/td][td]Apples[/td][td]Pears[/td][td]Pears[/td][td]Lemons[/td][td]Lemons[/td][td]Lemons[/td][td]Lemons[/td][td]Lemons[/td][/tr]
[tr][td]

5​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

6​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

7​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

8​

[/td][td]

6​

[/td][td]ABC[/td][td]Apples[/td][td]Oranges[/td][td]Lemons[/td][td]Pears[/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

9​

[/td][td]

8​

[/td][td]DEF[/td][td]Orange[/td][td]Lemons[/td][td]Pears[/td][td]Cucumbers[/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

10​

[/td][td]

10​

[/td][td]XYZ[/td][td]Apples[/td][td]Pears[/td][td]Lemons[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[tr][td]

11​

[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table]

In A8 just enter and copy down as far as needed:

=MATCH(REPT("z",255),$B2:$XFD2)

In C8 control+shift+enter, not just enter, copy across, and down:

=IFERROR(INDEX($B2:INDEX($B2:$XFD2,$A8),SMALL(IF(FREQUENCY(IF(1-($B2:INDEX($B2:$XFD2,$A8)=""),MATCH($B2:INDEX($B2:$XFD2,$A8),$B2:INDEX($B2:$XFD2,$A8),0)),TRANSPOSE(COLUMN($B2:INDEX($B2:$XFD2,$A8))-COLUMN($B2)+1)),TRANSPOSE(COLUMN($B2:INDEX($B2:$XFD2,$A8))-COLUMN($B2)+1)),COLUMNS($B2:B2))),"")

 

[Chartman of the Bored]

Thanks very much to both of you.