VBA Excel to cross-join multiple ranges without duplicates

CrossJoinRanges.vb

Sub CrossJoinRanges()
    Dim cn As ADODB.Connection
    Dim sql As String
    Dim outputSheet As Worksheet
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    Set cn = New ADODB.Connection
    With cn
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & ActiveWorkbook.FullName & ";" & _
              "Extended Properties=""Excel 12.0 XML;HDR=Yes"""
        .Open
    End With
    sql = "SELECT DISTINCT * FROM [Sheet1$A1:A2], [Sheet1$B1:B3], [Sheet1$C1:C3]"
    rs.Open sql, cn
    Set outputSheet = Sheets.Add
    outputSheet.Name = "CrossJoined"
    outputSheet.Range("A1").CopyFromRecordset rs
    rs.Close
    cn.Close
 End Sub