excel compare multiple columns

[ross_f]

I have some data that I want to see where there are repeated identical columns. My data is 500 columns, and varying rows of about 2000; the data is mainly text. The result I want is to see is which columns are the same. An example of the data and result wished are shown.

banana	apple	banana	apple	banana	apple
2​	2​	2​	3​	2​	3​
banana	banana	banana	apple	banana	apple
banana	banana	banana		banana
group1	group3	group6
group2
group4	group6

<tbody>
[TD="bgcolor: #bec0bf"]

[/TD]
[TD="bgcolor: #bec0bf"] group1
[/TD]
[TD="bgcolor: #bec0bf"] group2
[/TD]
[TD="bgcolor: #bec0bf"] group3
[/TD]
[TD="bgcolor: #bec0bf"] group4
[/TD]
[TD="bgcolor: #bec0bf"] group5
[/TD]
[TD="bgcolor: #bec0bf"] group6
[/TD]

[TD="bgcolor: #dcdcdc"] xray
[/TD]

[TD="bgcolor: #dcdcdc"] charlie
[/TD]
[TD="bgcolor: #dcdcdc"]

November​

[/TD]

[TD="bgcolor: #dcdcdc"] juliet
[/TD]

[TD="bgcolor: #dcdcdc"]

[/TD]

[TD="bgcolor: #dcdcdc"] Results
[/TD]

[TD="bgcolor: #dcdcdc"] a
[/TD]

[TD="bgcolor: #dcdcdc"] b
[/TD]

[TD="bgcolor: #dcdcdc"] c
[/TD]

</tbody>

Please help me from crazy.

 

[MickG]

Try this:-
Results sheet2

[COLOR="Navy"]Sub[/COLOR] MG25Jan35
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Stg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Cells("1", Columns.Count).End(xlToLeft).Column
    [COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
        [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
            Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Ac = 1 To Lst
    [COLOR="Navy"]If[/COLOR] Application.CountA(Rng.Offset(, Ac)) > 0 [COLOR="Navy"]Then[/COLOR]
        Stg = Join(Application.Transpose(Rng.Offset(, Ac)), ",")
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Stg) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Stg, Cells(1, Ac + 1)
        [COLOR="Navy"]Else[/COLOR]
            Dic.Item(Stg) = Dic.Item(Stg) & "," & Cells(1, Ac + 1)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    c = c + 1
    [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
        .Range("A1") = "Results"
        Sp = Split(Dic.Item(K), ",")
        .Range("A" & c) = c: .Range("B" & c).Resize(, UBound(Sp) + 1) = Sp
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] K
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[ross_f]

Hello Mick,
that looks brilliant, I hope you have enjoyed the challenge. That looks like quite an effort.

I was not expecting the answer to be VB, and the last time I played with VB was on a 1 day Excel training course about 20 years ago, where we spent perhaps 2 hours fiddling with VB - yes I have forgot the lot.
Unfortunately I don't have Excel at home, only LibreOffice, which needed some fixing, took all afternoon to download some little JRE. Download speed has gone down to 400kbps - what! When I did eventually plug in the code, it moaned with "BASIC syntax error. Unknown data type Range". Seems that 'Range' is not a supported VarType in LibreOffice, so that was all a waste of time. So tomorrow I'll have another go on a proper MS Office machine, where hopefully I'll get some real results and not excuses.

 

[ross_f]

Hello Mick,
works a treat. Thank you so much. It will make my life a little easier over the next few weeks.
Perhaps I should learn this VB, but then there is too much learn.
Wishing you all the best
Ross.

 

[MickG]

You're welcome