Explode two lists with all values of the other

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.

Image

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

Advertisements