List Unique Values from two worksheet in to Results TAB

Hi

I want to list unique values from two worksheet in to new worksheet
by selecting the range from sheet 1 and sheet 2. Columns and worksheets are not fixed one, hence wants to select through Range.

Seeking help of VBA code for this.

One method using arrays and a collection:

Sub NoDups()
    Dim var1 As Variant, var2 As Variant, var3 As Variant
    Dim col As New Collection, fVar() As String
    
    var1 = Application.InputBox(prompt:="Select range 1", Type:=8).Value
    var2 = Application.InputBox(prompt:="Select range 2", Type:=8).Value
    var3 = Split(Join(Application.Transpose(var1), ",") & "," & Join(Application.Transpose(var2), ","), ",")
    Erase var1: Erase var2
    On Error Resume Next
    For x = 0 To UBound(var3)
        col.Add var3(x), CStr(var3(x))
    Next x
    On Error GoTo 0
    Erase var3
    For x = 0 To col.Count - 1
        ReDim Preserve fVar(x): fVar(x) = col(x + 1)
    Next x
    Set col = Nothing
    Sheet3.Range("A2").Resize(x, 1) = Application.Transpose(fVar)
    Erase fVar
End Sub

Another method using copy paste & remove duplicates:

Sub NoDups2()
    Dim rng1 As Range, rng2 As Range
    
    Set rng1 = Application.InputBox(prompt:="Select range 1", Type:=8)
    Set rng2 = Application.InputBox(prompt:="Select range 2", Type:=8)
    rng1.Copy Sheet3.Range("A2")
    rng2.Copy Sheet3.Range("A" & Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1)
    Sheet3.Range("A:A").RemoveDuplicates 1, xlGuess
End Sub

Hope this helps

Hi CheesSandwich

Thanks for your help

I am getting Run time error 424 (Object requied

Sheet3.Range("A2").Resize(x, 1) = Application.Transpose(fVar)

I was changed the worksheet name also to "sheet3" still getting this error

How about if the line is:

Sheets("Sheet3").Range("A2").Resize(x, 1) = Application.Transpose(fVar)

Hi CheesSandwich

Thanks its working now as expected