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

"Bruno Campanini" wrote in message
...

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