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
|