Array to single row -- Any simple way to do this?

[Craig]

Is there an obvious formula to consolidate alphanumeric data across an
array of multiple rows and columns into one row of values which have
appeared at least once in the array (i.e., no duplicates)?

Example:

A B C
1 Apple Pear Orange
2 Grape Apple Pear
3 Melon Orange Grape

Result: Apple, Orange, Pear, Grape, Melon


I would also only like to show a value if it appears at least x times
across the array.

Example: (Must appear at least 2 times)

Result: Apple, Orange, Pear, Grape

Thanks for any and all help.

CB

 

[Frank Kabel]

Hi
any chance you could store the data in only one column?

 

[Craig]

Unfortunately not. The data is in a 6 x 60 array.

 

[Craig]

I should say that the data is intentionally output into 6x60 array.
The 6 rows are neccessary as they indicate 6 unique data sets.

 

[Myrna Larson]

There's no formula that I know of. The problem with the whole idea of a
formula is that it would have to be an array formula; with an array formula
you have to already know how many items there are that meet your criteria, in
order to select the correct number of cells when entering it.

Here's a VBA sub that will list the unique items that occur with a frequency
greater than or equal to what you specify in the input box. That list is
written in the first cell to the right of your data. The macro doesn't check
whether you already have data there; if you do, it will be overwritten. If you
specify, say 100, for the minimum frequency and there are no qualifying items,
the result is "No items"

Option Explicit

Sub GetItems()
Dim n As Long
Dim Rsp As String

Rsp = InputBox("Enter minimum number of occurrences.")
If Rsp <> "" And IsNumeric(Rsp) Then
n = CLng(Rsp)
If n > 0 Then
GetItems_ Selection, n
End If
End If
End Sub

Private Sub GetItems_(aRange As Range, MinOccurrences As Long)
Dim C As Long
Dim i As Long
Dim Keep As Boolean
Dim n As Long
Dim R As Long
Dim V As Variant
Dim X() As Variant
Dim y As Variant

ReDim X(1 To aRange.Cells.Count)
V = aRange.Value

For R = 1 To UBound(V, 1)
For C = 1 To UBound(V, 2)
y = V(R, C)
Keep = False
If MinOccurrences > 1 Then
Keep = (Application.CountIf(aRange, y) >= MinOccurrences)
Else
Keep = True
End If
If Keep Then
If IsError(Application.Match(y, X, 0)) Then
n = n + 1
X(n) = y
End If
End If
Next C
Next R
If n = 0 Then
n = 1
X(n) = "No items"
End If
aRange.Offset(0, aRange.Columns.Count).Resize(1, n).Value = X
End Sub