"JANA" <JANA@discussions.microsoft.com> wrote in message
news:D351ADB4-0F14-47D8-A1F0-0F81C7BA5CF1@microsoft.com...
>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
Bookmarks