combine code for Matching and Unmatched into one module

You will need to be much more specific.  This is a comment rather than a question.  Please provide details and/or specific examples in order for us to help you.

Since the original code was written by Faustus, I believe he should first dibs on it, since he is also familiar with the code. Hopefully he posts by tomorrow so we don't keep others waiting too long.

Since the original code was written by Faustus, I believe he should first dibs on it, since he is also familiar with the code. Hopefully he posts by tomorrow so we don't keep others waiting too long.

Even though you have expressed your desire for a specific "Expert" to provide a solution in preference to anybody else, that should not deter other proposals being put forward & you assessing these on their own merits as they are presented to you.

An "Expert" engaged in a previous thread where the topic was the same, or was of a similar nature, may not contribute on a subsequent occasion, so you would be wise to not restrict the audience & alienate any other "Expert" from offering advice.

I only did that because I was not to post too much code in posts and since this code exists I other threads it would take a lot of file. Nonetheless, I apologize and will post the necessary code tomorrow when I have access to the PC with the code.

I hate digging in other people's code for two reasons. For one, everybody has his own way of writing code for the very simple reason that everybody thinks that their particular way is the most efficient. If it weren't they would write the code differently.
For another, very often the code written at one time doesn't appear as efficient on second thought as it appeared at design time. Therefore there is a tendency to implement improvements, tempered only by the argument that something that isn't broken doesn't need fixing.
Digging in someone else's code brings out the worst in me on both counts, usually ending in my re-writing the code which is fair neither to the original author nor to myself, with the largely disinterested beneficiary exercising confounded tolerance.
Bottom line:- Please give extra credit to any one else taking on this ungrateful task. For me it's a lot easier, and I'll do it tomorrow.

The code below finds umatched number sets in the attached file. The code in the file itself is the code to find matching sets. The idea is to combine both in the same file.

Thank you for your patience. This system gives me a problem every so often whenever i try to upload files.

Option Explicit
Option Base 0

    Const ResultSheetName As String = "Unmatched"        ' modify as desired

    Private Enum Npa                    ' Program parameters
        NpaMaxPose = 65535              ' max rows that can be transposed
        NpaMaxRows = 1048576            ' max rows per sheet
    End Enum
    
    Private Enum Nwm                    ' WsM: Worksheets navigation
        NwmStart = 1                    ' display start time
        NwmEnd
        NwmLapsed
        NwmFirstDataRow
        NwmTest = 1                     ' Column A = 1
        NwmFirstData                    ' = column next to NwmTest
    End Enum
    
    Private Enum Nws                    ' WsS: Worksheets navigation
        NwsFirstData = 2                ' Column B = 2
        NwsPreCount = 2                 ' Number of data columns used for pre-sorting
        NwsColCount = 5                 ' Total number of data columns
    End Enum

Sub ListUnmatched()

    ' modify as required:-
    Const Numbers As String = "Numbers_"

    Dim WsM As Worksheet            ' Result sheet: Matching
    Dim WsS As Worksheet            ' Source sheets: Numbers_?
    Dim Rslt()
    
    Set WsM = GetSheet(ResultSheetName, True)
    RecordTime WsM
    SetApplication False
    DeletePreviousResults           ' all sheets with numbers as names
                                    ' or names commencing with "XX DEL"
    
    For Each WsS In ThisWorkbook.Worksheets
        ' only tabs named with the variable 'Numbers' string
        ' followed by a number will be processed
        If InStr(1, WsS.Name, Numbers, vbTextCompare) = 1 Then
            If IsNumeric(Mid(WsS.Name, Len(Numbers) + 1)) Then
                CreateTempList WsS
            End If
        End If
    Next WsS
    SortSheets
    
    For Each WsS In ThisWorkbook.Worksheets
        With WsS
            If IsNumeric(WorksheetFunction.Substitute(.Name, " ", "")) Then
                SortColumnA WsS
                Rslt = GetResult(WsS)
                If IsUsed(Rslt) Then ConvertAndWriteResult Rslt, WsM
            End If
        End With
    Next WsS
    
    If MsgBox("Do you wish to retain the pre-sorting result tabs?" & vbCr & _
              "Press 'Yes' to prevent these tabs from being" & vbCr & _
              "deleted at this time." & vbCr & vbCr & _
              "You can run the procedure 'TestMan.CountResultRows'" & vbCr & _
              "to analize the pre-sorting results." & vbCr & vbCr & _
              "This program will delete all pre-sorting results," & vbCr & _
              "as well as the tab '" & ResultSheetName & "' when you run" & vbCr & _
              "the procedure 'ListMatching' again.", _
              vbYesNo + vbDefaultButton2 + vbQuestion, _
              "Final cleanup") <> vbYes Then DeletePreviousResults
    WsM.Activate
    RecordTime WsM, IsEnd:=True
    SetApplication True
End Sub

Private Sub ConvertAndWriteResult(Arr() As Variant, _
                                  WsM As Worksheet)

    Dim PageArr()
    Dim MatchArr() As String
    Dim Dest As Range
    Dim Rl As Long
    Dim R As Long
    Dim C As Long
    Dim i As Long

    For R = 1 To UBound(Arr)
        If Len(Arr(R)) Then
            i = i + 1
            MatchArr = Split(Arr(R))
            ReDim Preserve PageArr(1 To NwsColCount, 1 To i)
            For C = 0 To UBound(MatchArr)
                PageArr(C + 1, i) = MatchArr(C)
            Next C
        End If
        
        If i = NpaMaxPose Or R = UBound(Arr) Then
            Rl = LastRow(NwmFirstData, WsM) + 1
            If Rl < NwmFirstDataRow Then Rl = NwmFirstDataRow
            Set Dest = WsM.Cells(Rl, NwmFirstData)
            Set Dest = Dest.Resize(UBound(PageArr, 2), UBound(PageArr))
            Dest.Value = Application.Transpose(PageArr)
            i = 0
            Erase PageArr
        End If
    Next R
End Sub

Private Function GetResult(WsS As Worksheet) As Variant()

    Dim PageArr()
    Dim Rslt()
    Dim IsDupl As Boolean
    Dim R As Long

    With WsS
        R = LastRow(1, WsS)
        If R Then
            If R = 1 Then
                ReDim PageArr(1 To 1, 1 To 1)
                PageArr(1, 1) = .Cells(1, 1).Value
            Else
                PageArr = Range(.Cells(1, 1), .Cells(R, 1)).Value
            End If
        Else
            Exit Function
        End If
    End With
    
    For R = 1 To UBound(PageArr) - 1
        If PageArr(R, 1) = PageArr(R + 1, 1) Then
            IsDupl = True
        Else
            If IsDupl Then
                IsDupl = False
            Else
                AddToResult R, WsS, PageArr, Rslt
            End If
        End If
    Next R

    If Not IsDupl Then
        AddToResult R, WsS, PageArr, Rslt
    End If
    
    GetResult = Rslt
End Function

Private Sub AddToResult(ByVal R As Long, _
                        WsS As Worksheet, _
                        PageArr(), _
                        Rslt())
    
    Dim i As Long
    
    On Error Resume Next
    i = UBound(Rslt)
    i = i + 1
    ReDim Preserve Rslt(1 To i)
    Rslt(i) = WsS.Name & " " & PageArr(R, 1)
End Sub

Private Sub CreateTempList(WsS As Worksheet)
    
    Dim WsT As Worksheet            ' Temporary sheet
    Dim PageArr()
    Dim MatchArr()
    Dim PreMatch As String
    Dim PrevPre As String
    Dim R As Long
    Dim Rl As Long
    Dim i As Long

    Rl = LastRow(NwsFirstData, WsS)
    R = FirstRow(NwsFirstData, Rl, WsS)
    With WsS
        If Rl = NwsFirstData Then
            ReDim PageArr(1, 1)
            PageArr(1, 1) = WsS.Cells(1, NwsFirstData).Value
        Else
            PageArr = Range(.Cells(R, NwsFirstData), _
                            .Cells(Rl, NwsFirstData + NwsColCount - 1)).Value
        End If
    End With

    For R = 1 To UBound(PageArr)
        PreMatch = TestString(R, NwsFirstData, _
                              NwsFirstData + NwsPreCount - 1, PageArr)
        If PreMatch <> PrevPre Then
            If IsUsed(MatchArr) Then
                WriteArrayToColumn MatchArr, 1, WsT
                i = 0
            End If
            Set WsT = GetSheet(PreMatch)
        End If
        i = i + 1
        ReDim Preserve MatchArr(1 To i)
        MatchArr(i) = TestString(R, NwsFirstData + NwsPreCount, _
                                 UBound(PageArr, 2) + 1, PageArr)
        PrevPre = PreMatch
    Next R
    WriteArrayToColumn MatchArr, 1, WsT
End Sub

Private Function TestString(ByVal R As Long, _
                            ByVal Cstart As Long, _
                            ByVal Cend As Long, _
                            PageArr()) As String
    
    Dim TestArr() As String
    Dim Ctop As Long
    Dim i As Long

    Ctop = Cend - Cstart
    ReDim TestArr(Ctop)
    For i = 0 To Ctop
        TestArr(i) = Format(PageArr(R, Cstart + i - 1), "00")
    Next i
    TestString = Join(TestArr)
End Function

Private Sub WriteArrayToColumn(Arr() As Variant, _
                               ByVal Col As Long, _
                               Ws As Worksheet)

    Dim Tmp() As Variant
    Dim Dest As Range           ' paste destination
    Dim R As Long, C As Long
    Dim i As Long, j As Long, k As Long

    R = LastRow(Col, Ws)
    i = R + UBound(Arr)
    If i > NpaMaxRows Then
        i = UBound(Arr)
        ReDim Preserve Arr(NpaMaxRows - R)
        MsgBox "Adding the array to the column would require" & vbCr & _
               "more worksheet rows than Excel can handle." & vbCr & _
               "The last " & i - UBound(Arr) & _
               " array elements have been truncated."
    End If

    R = 1
    C = -Int(UBound(Arr) / -NpaMaxPose)
    For i = 1 To C
        ReDim Tmp(1 To IIf(i = C, (UBound(Arr) Mod NpaMaxPose), NpaMaxPose))
        For j = 1 To NpaMaxPose
            k = R + j - 1
            If k > UBound(Arr) Then Exit For
            Tmp(j) = Arr(k)
        Next j

        Set Dest = Ws.Cells(LastRow(Col, Ws) + 1, Col)
        Set Dest = Dest.Resize(UBound(Tmp), 1)
        Dest.Value = Application.Transpose(Tmp)
        R = i * NpaMaxPose + 1
    Next i
    Erase Arr
End Sub

Private Function GetSheet(ByVal Sn As String, _
                          Optional ByVal GetNew As Boolean) As Worksheet

    Dim Idx As Long
    
    If GetNew Then DelSheet Sn
    With ThisWorkbook
        On Error Resume Next
        Set GetSheet = .Sheets(Sn)
        If Err = 0 Then Exit Function
        
        On Error GoTo 0
        Set GetSheet = .Worksheets.Add(Before:=.Sheets(1))
        ActiveSheet.Name = Sn
    End With
End Function

Private Sub DeletePreviousResults()
    
    Dim Ws As Worksheet
    
    For Each Ws In ThisWorkbook.Worksheets
        If IsNumeric(WorksheetFunction.Substitute(Ws.Name, " ", "")) _
           Or InStr(Ws.Name, "XX DEL") > 0 Then
            DelSheet Ws.Name
        End If
    Next Ws
End Sub

Private Sub DelSheet(ByVal Sn As String)

        On Error Resume Next
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets(Sn).Delete
        Application.DisplayAlerts = True
End Sub

Private Function IsUsed(Arr()) As Boolean
    
    Dim test As Long
    
    On Error Resume Next
    test = UBound(Arr)
    IsUsed = Not CBool(Err)
End Function

Function FirstRow(ByVal Col As Long, _
                  ByVal Rl As Long, _
                  Ws As Worksheet) As Long
    Dim R As Long

    R = 1
    Do While Len(Ws.Cells(R, Col).Value) = 0 _
             And Rl > R
        R = R + 1
    Loop
    FirstRow = R
End Function

Function LastRow(ByVal Col As Variant, _
                 Ws As Worksheet) As Long
    ' 0059 V 3.2x Sep 16, 2013
    Dim R As Long

    With Ws
        R = .Cells(.Rows.Count, Col).End(xlUp).Row
        With .Cells(R, Col)
            If R = 1 And .Value = vbNullString Then R = 0
            LastRow = R + .MergeArea.Rows.Count - 1
        End With
    End With
End Function

Private Sub SetApplication(ByVal Target As Boolean)
    With Application
        .ScreenUpdating = Target
        .Cursor = IIf(Target, xlDefault, xlWait)
    End With
End Sub

Private Sub RecordTime(WsM As Worksheet, _
                       Optional ByVal IsEnd As Boolean)
    
    Const DateFormat As String = " d.m.yy  h:mm:ss"
    Dim Lapsed As Double
    
    With WsM.Columns(1)
        If IsEnd Then
            .Cells(NwmEnd).Value = "Finished: " & Format(Now, DateFormat)
            Lapsed = Now - .Cells(NwmStart).Value
            With .Cells(NwmLapsed)
                .NumberFormat = """Lapsed:  ""[HH]:mm:ss"
                .HorizontalAlignment = xlLeft
                .Value = Lapsed
            End With
        Else
            With .Cells(NwmStart)
                .NumberFormat = """Started: """ & DateFormat
                .HorizontalAlignment = xlLeft
                .Value = Now
                .Columns.AutoFit
            End With
            .Cells(NwmEnd).Value = "This may take some time. Please wait patiently :-)"
        End If
    End With
End Sub

Private Sub SortColumnA(Ws As Worksheet)

    Dim Rng As Range
    
    With Ws.Columns(1)
        Set Rng = Range(.Cells(1), .Cells(LastRow(1, Ws)))
    End With
    
    With Ws.Sort
        With .SortFields
            .Clear
            .Add Key:=Range("A1"), _
                 SortOn:=xlSortOnValues, _
                 Order:=xlAscending, _
                 DataOption:=xlSortTextAsNumbers
        End With
        .SetRange Rng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub SortSheets()

    Dim Done As Boolean
    Dim LastToSort As Integer
    Dim i As Integer
    
    With ThisWorkbook.Worksheets
        On Error Resume Next
        LastToSort = .Item(ResultSheetName).Index
        If LastToSort = 0 Then LastToSort = .Count
        On Error GoTo 0
        
        Do
            Done = True
            For i = 1 To LastToSort - 2
                If StrComp(.Item(i + 1).Name, .Item(i).Name, _
                           vbTextCompare) = True Then
                    .Item(i + 1).Move Before:=.Item(i)
                    Done = False
                End If
            Next i
        Loop Until Done
    End With
End Sub

Select allOpen in new window

Copy-of-EXX-130918-Match-Combina.xlsb

Excellent work, Thank you.