From time to time, and I must admit, it doesn’t happen often, but often enough to justify making a macro, you will want to match two lists, e.g. a list of employees and a list of G/L accounts, and get as a result a line for each possible combination of employees and accounts.
Here’s the excel version.
1. Copy the code listed at the end of this post in a standard VB module
2. Select both ranges: you select the employee list with the mouse, then press Ctrl, release the mouse button (while still holding the Ctrl key down) and select the GL list.
3. Run the macro: you now have a new tab with the expanded list ready for consumption.
Try it, you might like it.
Thomas
Here’s the code:
Sub ExplodeLists()
Dim rg1 As range, rg2 As range, shtDest As Worksheet, rgCell As range
Dim lLoop As Long, lRowDest As Long
‘turn off updates to speed up code execution
With application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
If selection.Areas.Count <> 2 Then
MsgBox “Select two areas to join”
Exit Sub
End If
Set rg1 = selection.Areas(1)
Set rg2 = selection.Areas(2)
Set shtDest = Worksheets.Add
lRowDest = 1
For lLoop = 1 To rg1.Rows.Count
shtDest.Cells(lRowDest, 1).Resize(rg2.Rows.Count, rg1.Columns.Count).Value = rg1.Rows(lLoop).Value
rg2.Copy shtDest.Cells(lRowDest, 1 + rg1.Columns.Count)
lRowDest = lRowDest + rg2.Rows.Count
Next
With application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
A CFO's Excel blog 
Sorry, this is not an OUTER JOIN, this is a cartesian expansion.
Still interesting and nice to have if you needed it, but not an OUTER JOIN.
Peter, you are fully correct. I just didn’t seem to find the right way of putting it, so used the wrong way of putting it that made the most sense to me.
I’ve updated the title accordingly.
Thanks
The real OUTER JOIN simulation is the following code, that expands both list so empty cells are inserted when one of the values is not matched:
Sub Matchrows_OUTERJOIN_Sim()
‘Matches two ranges by inserting lines in both ranges so each value is on the same line
‘you first need to
‘ sort the two data blocks on the first column
‘ select the two data blocks you want to split and match
Dim rg1 As range, rg2 As range, firstMatch As Boolean
Dim i As Long, j As Long, foundRow As Long
application.ScreenUpdating = False
If selection.Areas.Count 2 Then
MsgBox “Select two areas”
Exit Sub
End If
Set rg1 = selection.Areas(1)
Set rg2 = selection.Areas(2)
‘gets the number of unique values in the first rows of range 1 and 2, to be able to run the loop all the way
Dim cUnique As New Collection
On Error Resume Next
With rg1
For i = 1 To .Columns(1).Cells.Count
cUnique.Add .Cells(i, 1), CStr(.Cells(i, 1))
Next
End With
With rg2
For i = 1 To .Columns(1).Cells.Count
cUnique.Add .Cells(i, 1), CStr(.Cells(i, 1))
Next
End With
On Error GoTo 0
‘boolean needed to be able to resize range 2 if required
firstMatch = True
For i = 1 To cUnique.Count
If WorksheetFunction.CountA(rg1.Rows(i)) = 0 _
Or WorksheetFunction.CountA(rg2.Rows(i)) = 0 _
Or rg1.Cells(i, 1).Offset(0, rg2.Column – rg1.Column) = rg1.Cells(i, 1) Then
firstMatch = False
GoTo nxt_i:
End If
On Error Resume Next
foundRow = rg2.Columns(1).Find(What:=rg1.Cells(i, 1), LookIn:= _
xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False).Row
If Err 0 Then
Err.Clear
rg1.Cells(i, 1).Offset(0, rg2.Column – rg1.Column).Resize(, rg2.Columns.Count).Insert Shift:=xlDown
If firstMatch Then Set rg2 = rg2.Offset(-1).Resize(rg2.Rows.Count + 1)
Else
If i < foundRow Then
rg1.Offset(i – 1).Cut Cells(foundRow, rg1.Column)
Else
rg2.Rows(foundRow – rg2.Row + 1).Cut
rg2.Rows(i).Insert Shift:=xlDown
End If
firstMatch = False
End If
nxt_i:
Next
application.ScreenUpdating = True
End Sub