Search multiple values & return single value - seperate worksheets

[JANA]

I have a worksheet that has multiple laobr categories listed on different
columns and rows in a worksheet. I want to pull each value only once and
list them in different rows in a different worksheet. See example below. I
have not been able to find a way to do this - please help!
Thanks,
Jana

WORKSHEET A
A B C D E F
1 Name S1 Name S2 Name S4
2 Name S2 Name S1 Name T3
3 Name S5 Name S3 Name S1
4 Name S6 Name S4 Name E2
5 Name S7 Name E2 Name S7
6 Name S8 Name T1 Name S5

I want to deliver the data from Worksheet A, columns B, D & F into column H
in Worksheet B, but only list each value once. I do not need the data in any
certain order, just need each to only list once & have each on a different
line.

WORKSHEET B
Col H
1 S1
2 S2
3 S5
4 S6
5 S7
6 S8
7 S3
8 S4
9 E2
10 T1
11 T3

 

[Bruno Campanini]

I have a worksheet that has multiple laobr categories listed on different
columns and rows in a worksheet. I want to pull each value only once and
list them in different rows in a different worksheet. See example below.
I
have not been able to find a way to do this - please help!
Thanks,
Jana

WORKSHEET A
A B C D E F
1 Name S1 Name S2 Name S4
2 Name S2 Name S1 Name T3
3 Name S5 Name S3 Name S1
4 Name S6 Name S4 Name E2
5 Name S7 Name E2 Name S7
6 Name S8 Name T1 Name S5

I want to deliver the data from Worksheet A, columns B, D & F into column
H
in Worksheet B, but only list each value once. I do not need the data in
any
certain order, just need each to only list once & have each on a different
line.

WORKSHEET B
Col H
1 S1
2 S2
3 S5
4 S6
5 S7
6 S8
7 S3
8 S4
9 E2
10 T1
11 T3

I'll try to build up a formula, in the mean time the following
does the job (you must set up the 4 definitions):

============================
Sub Button52_Click()
Dim TargetRange As Range, RangeArray(1 To 3) As Range
Dim CurrentRange As Range
Dim MyDic As Object, i, j As Long, k As Long

' Definitions
Set RangeArray(1) = [Sheet10!AA11]
Set RangeArray(2) = [Sheet10!AB11]
Set RangeArray(3) = [Sheet10!AC11]
Set TargetRange = [Sheet2!A281]

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set MyDic = CreateObject("Scripting.Dictionary")
For j = 1 To 3
Set CurrentRange = RangeArray(j)
For Each i In Range(CurrentRange, CurrentRange.End(xlDown))
On Error GoTo Continue_1
MyDic.Add i.Value, i
On Error GoTo 0
k = k + 1
TargetRange.Offset(k - 1, 0) = i
Continue_2:
Next
Next

Exit_Sub:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub

Continue_1:
Resume Continue_2

End Sub
===========================

Ciao
Bruno

 

[GerryK]

Might be easiest to copy all the value in B, D and F to Sheet 2 A1...end.
Then eliminate the duplicates thus:
Select the range(A1...end), use Data/Filter/Advanced filter
check Unique Records Only and "Copy to another location"
Put in an address to hold the result, [H1], then click OK. When
you're done, you will have the unique records in the new
place. You can delete the original range or not.

HTH

 

[Herbert Seidenberg]

To copy data to sheet B, H2, you can use this formula

=INDEX(array_h,MOD((ROW()-2),ROWS(array_h))+1,
FLOOR((ROW()-2)/ROWS(array_h)+1,1)*2)

(array_h is the named array A1:F6)
Advanced filter needs a label. Put it into H1.
Then continue with GerryK's instructions.

 

[Bruno Campanini]

I'll try to build up a formula, in the mean time the following
does the job (you must set up the 4 definitions):

[...]

Simplifying:

==========================
Sub ColumnGroup()
Dim TargetRange As Range, SourceRangeArray(1 To 3) As Range
Dim MyDic As Object, i, j As Long

' Definitions
Set SourceRangeArray(1) = [Sheet10!AA11]
Set SourceRangeArray(2) = [Sheet10!AB11]
Set SourceRangeArray(3) = [Sheet10!AC11]
Set TargetRange = [Sheet2!A281]

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Set MyDic = CreateObject("Scripting.Dictionary")
For j = 1 To 3
For Each i In Range(SourceRangeArray(j),
SourceRangeArray(j).End(xlDown))
On Error Resume Next
MyDic.Add i.Value, i
On Error GoTo 0
Next
Next

Range(TargetRange, TargetRange.Offset(MyDic.Count - 1, 0)) = _
Application.Transpose(MyDic.Keys)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub
===========================

Ciao
Bruno