View Single Post
  #2   Report Post  
Bruno Campanini
 
Posts: n/a
Default Search multiple values & return single value - seperate worksheets

"JANA" wrote in message
...
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