VBA Excel to cross-join multiple ranges without duplicates
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