Recognizing Repeating Data-Groups

[Guest]

I confess I tried asking this question earlier and either I did a poor job of
phrasing it or something else went awry.

If Excel has data in a column, and that data is a subset within a group that
is defined by a column heading; can Excel compare that original data array
(the sub-set) with other columnar data arrays and somehow flag the ones that
are identical to the original?

Example:
Header: Grocery Items

Array:
Onions
Cucumbers
Lettuce
Potatoes
Cabbage

If the unique array defined above shows up under another column, which has
the heading Vegetables, can Excel recognize that the elements of the two sets
are identical and that no element of one is excluded from the group of
elements in the other? More importantly, can it "tell" me that it's found a
matching array?

How would I approach this? I can't create a phrase of VB, so if it takes
some Macro-writing, please tell me what to write. I can copy VB all day
long, I just don't "speak it". Thanks in advance for trying to help.

 

[Guest]

Try this: assumptions are headers are in row 1and data (lists) start in row 2
from Column A onwards. Output on Sheet 2 lists exact duplicates or short
lists which are a subset of a longer list.

Option Explicit
Sub FindDuplicateLists()


Dim hdrow As Long, mrow As Long
Dim maxcol As Integer, ncol As Integer, mcol As Integer
Dim i As Integer, j As Integer, matched As Integer, c As Integer
Dim irow As Long, jrow As Integer
Dim res As Variant
Dim rng1 As Range, rng2 As Range, cell As Range

Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")

ws1.Activate
With ws1
maxcol = .Cells(1, Columns.Count).End(xlToLeft).Column
hdrow = 1 ' <=== Header row
' Set headings in Sheet2
ws2.Cells(1, 1).Resize(1, 2) = Array("Header", "Duplicated in list(s)")
For c = 1 To maxcol
ws2.Cells(c + 1, 1) = .Cells(hdrow, c)
Next c
'Loop through columns
For i = 1 To maxcol
irow = .Cells(Rows.Count, i).End(xlUp).Row
Set rng1 = Range(.Cells(2, i), .Cells(irow, i))
mcol = 1
For j = 1 To maxcol
If i <> j Then
jrow = .Cells(Rows.Count, j).End(xlUp).Row
Set rng2 = Range(.Cells(2, j), .Cells(jrow, j))
matched = 0
For Each cell In rng1
res = Application.Match(cell, rng2, 0)
If Not IsError(res) Then matched = matched + 1
Next
' Do all items match ?
If irow - 1 = matched Then
mcol = mcol + 1
mrow = Application.Match(.Cells(hdrow, j), ws2.Range("A1:A"
& maxcol + 1), 0) - 1
ws2.Cells(i + 1, mcol) = .Cells(hdrow, mrow)
End If
End If
Next j
Next i
End With
End Sub

HTH