Join multi-column ranges in Excel

ExcelJoin.vb

' Licensed under the Apache License, Version 2.0 (the "License"); you may not
' use this file except in compliance with the License. You may obtain a copy of
' the License at
'
'   http://www.apache.org/licenses/LICENSE-2.0
'
' Unless required by applicable law or agreed to in writing, software
' distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
' WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
' License for the specific language governing permissions and limitations under
' the License.

' Join columns from the second range onto the first range when the first columns match
' Skips the specified number of columns in the second range
' Requires that both ranges are sorted by the first column
' Stops processing on empty columns
Sub JoinRangesOnFirstColumn()

    Dim source(2) As Range
    Set source(1) = Sheets("LIST A").Range("a2:g1000")
    Set source(2) = Sheets("LIST B").Range("a2:g1000")
    
    Dim NumberOfColumnsToSkip As Integer
    NumberOfColumnsToSkip = 4

    Dim dest As Range
    Set dest = Sheets("RESULT").Range("a2:z2500")
    
    Dim sourceRow(2) As Integer
    Dim destRow As Integer
    sourceRow(1) = 1
    sourceRow(2) = 1
    destRow = 1
    
    Do
        If sourceRow(1) <= source(1).Rows.Count And source(1).Cells(sourceRow(1), 1) <> "" Then
            If sourceRow(2) <= source(2).Rows.Count And source(2).Cells(sourceRow(2), 1) <> "" Then
                If source(1).Cells(sourceRow(1), 1) <> source(2).Cells(sourceRow(2), 1) Then
                    Call CopyRow(source(1), sourceRow(1), dest, destRow)
                Else
                    Call joinRow(source(1), sourceRow(1), dest, destRow, source(2), sourceRow(2), NumberOfColumnsToSkip)
                End If
            Else
                Call CopyRow(source(1), sourceRow(1), dest, destRow)
            End If
        Else
            Exit Do
        End If
    Loop

End Sub

' Bad form: Updates source and dest row offsets!
Sub CopyRow(ByRef source As Range, ByRef sourceRow As Integer, ByRef dest As Range, ByRef destRow As Integer)
     For srcC = 1 To source.Columns.Count
        dest.Cells(destRow, srcC) = source.Cells(sourceRow, srcC)
     Next
     
     sourceRow = sourceRow + 1
     destRow = destRow + 1
End Sub

Sub joinRow(ByRef source As Range, ByRef sourceRow As Integer, ByRef dest As Range, ByRef destRow As Integer, ByRef join As Range, ByRef joinRow As Integer, ByVal skipCount)
     For srcC = 1 To source.Columns.Count
        dest.Cells(destRow, srcC) = source.Cells(sourceRow, srcC)
        If dest.Cells(destRow, srcC) = "" Then Exit For
     Next
     
     For joinC = 1 + skipCount To join.Columns.Count
        dest.Cells(destRow, srcC + joinC - skipCount - 1) = join.Cells(joinRow, joinC)
     Next
     
     sourceRow = sourceRow + 1
     destRow = destRow + 1
     joinRow = joinRow + 1
End Sub