I have long searched for a way to match 2 arrays based on several conditions and then write a value to that array after those conditions are met. I HAVE done so, BUT it is far to slow and crashes Excel. I am trying to use the dictionary object to achieve this in an effort to speed up my matching procedure but I am failing miserably. 

Simply put, in the below procedure, I am checking if certain conditions are true. If so then then write to `OutPut_Array` so that I can match the value found in the `ShtInPut_Array` later. 

```
Sub Cat_Payments_Test2()

  Dim InPut_Array As Variant, ShtInPut_Array As Variant
  Dim OutPut_Array()
  Dim i As Long
  Dim x As Long, y As Long

    With Application
      .ScreenUpdating = False
      .EnableEvents = False
    End With

    'Would have used Value 2, but I want to preseve the Date formating
    InPut_Array = Sheet19.Range("A1:NWH26").Value
    ShtInPut_Array = Sheet14.Range("A2:Z50667").Value

        ReDim OutPut_Array(1 To 3, LBound(InPut_Array, 2) To UBound(InPut_Array, 2))

       'The Part is super fast
        'On Error Resume Next
        For i = LBound(InPut_Array, 2) To UBound(InPut_Array, 2)
            'Case 1: InPut_Array(14, i) is on the first day of the month
            If InPut_Array(15, i) = (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) Then
                    'Looking for payments On First Day of CurrMonth
                   If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
                   And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") _
                   Or InStr(InPut_Array(16, i), "*Req Adj*")) And Not (InStr(InPut_Array(16, i), "Prior")) Then

                            InPut_Array(25, i) = "Payment"
                            InPut_Array(26, i) = "Repair Order"

                   ElseIf Len(InPut_Array(20, i)) = 7 And IsNumeric(InPut_Array(20, i)) And (InStr(InPut_Array(15, i), "Prior") _
                   Or InStr(InPut_Array(15, i), "Current")) And InPut_Array(19, i) < 0 Then

                            InPut_Array(24, i) = "RO/Accr Adj."
                            InPut_Array(25, i) = "Reversing Entry"
                   End If

            'Case 2 : InPut_Array(14, i) is between the first day of the month and the last day of the month
            ElseIf (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) < InPut_Array(14, i) < WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
                    'Looking for payments MidMonth (i.e. after the FirstDay_CurrMon _
                    but before LastDayCurrMont
                    If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) _
                    Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) And Not (InStr(InPut_Array(16, i), "Prior")) Then

                            InPut_Array(25, i) = "Payment"
                            InPut_Array(26, i) = "Repair Order"

                            'Write PO Num
                            OutPut_Array(1, i) = InPut_Array(21, i)
                            'Print the first day of the current month's date
                            OutPut_Array(2, i) = DatePart("d", (CDate(InPut_Array(15, i)) - Day(CDate(InPut_Array(15, i))) + 1))
                            'Print the Amount
                            OutPut_Array(3, i) = Abs(InPut_Array(20, i))

                    End If

            'Case 3.1 and 3.2
            ElseIf InPut_Array(15, i) = WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
                    If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
                    And (InStr(InPut_Array(16, i), "Prior") Or InStr(InPut_Array(16, i), "Current")) _
                    And InPut_Array(20, i) < 0 Then

                            InPut_Array(25, i) = "RO/Accr Adj."
                            InPut_Array(26, i) = "Repair Order"

                            'Write PO Num
                            OutPut_Array(1, i) = InPut_Array(21, i)
                            'Print the first day of the current month's date
                            OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
                            'Print Amount
                            OutPut_Array(3, i) = Abs(InPut_Array(20, i))

                    'If criteria met for payment on the last day of the Current Month _
                    then do the same as payments for MidMonth
                    ElseIf Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) _
                    Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
                    And Not (InStr(InPut_Array(16, i), "Prior")) Then

                            InPut_Array(25, i) = "Payment"
                            InPut_Array(26, i) = "Repair Order"

                            'PO Num
                            OutPut_Array(1, i) = InPut_Array(21, i)
                            'Print the first day of the current month's date
                            OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
                            'Print Amount
                            OutPut_Array(3, i) = Abs(InPut_Array(20, i))
                    End If
            End If
        Next i

            'This matching procedure is what is crashing excel
           For x = LBound(ShtInPut_Array, 1) To UBound(ShtInPut_Array, 1)
            For y = LBound(OutPut_Array, 2) To UBound(OutPut_Array, 2)
               If ShtInPut_Array(x, 21) = OutPut_Array(1, y) _
               And DatePart("d", ShtInPut_Array(x, 15)) = OutPut_Array(2, y) _
               And Abs(ShtInPut_Array(x, 20)) = OutPut_Array(3, y) Then

               ShtInPut_Array(x, 25) = "RO/Accr Adj."
               ShtInPut_Array(x, 26) = "Repair Order"
                Exit For
                End If
            Next y
        Next x

        Sheet17.Range("A2").Resize(UBound(ShtInPut_Array, 1), UBound(ShtInPut_Array, 2)) = ShtInPut_Array

           Application.EnableEvents = True

End Sub

```

I have been trying to figure this out for a good week or more, and if I told you how many test modules that I have now from skimming SO and literally everywhere else, you would think I am insane. My thoughts where to adapt @TimWilliams idea from [This](https://stackoverflow.com/questions/35777978/vba-comparing-two-2d-arrays-rows-vba-throws-type-mismatch-declarations-ok) post, but I would need array indexes, not addresses. At this point I need some SO genius. Thanks to all those with ideas, or answers!

**Edit:** Below is the full working code with @TimWilliams Dictionary Implementation (many many thanks Tim). The only difference is, I choose to use *early binding* instead of *late binding* for the `Dictionary` Object. To do this, you must reference *Microsoft Scripting Runtime* in the Visual Basic Editor (*VBE*) by selecting *Tools > References > Microsoft Scripting Runtime*. Early binding adds a bit more speed because you are informing Excel about the object ahead of runtime. It also enables the *VBE's* intellisense feature, which is nice for quickly accessing the properties and methods of an object. 

```
 Sub Cat_Payments_Test2()

 Dim InPut_Array As Variant, ShtInPut_Array As Variant
 Dim OutPut_Array()
 Dim i As Long
 Dim x As Long, y As Long
 Dim Dict As Dictionary 'Early Binding
 Dim k As Variant

  With Application
    .ScreenUpdating = False
    .EnableEvents = False
  End With

  'Would have used Value 2, but I want to preseve the Date formating
  InPut_Array = Sheet19.Range("A1:NWH26").Value
  ShtInPut_Array = Sheet14.Range("A2:Z50667").Value

    ReDim OutPut_Array(1 To 3, LBound(InPut_Array, 2) To UBound(InPut_Array, 2))

    For i = LBound(InPut_Array, 2) To UBound(InPut_Array, 2)
        'Case 1: GL/Date (i.e.InPut_Array(14, i)) is on the first day of the month
        If InPut_Array(15, i) = (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) Then
                'Looking for payments On First Day of CurrMonth
               If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
               And InPut_Array(20, i) > 0 And (InPut_Array(16, i) = InPut_Array(17, i) Or _
               InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
               And Not (InStr(InPut_Array(16, i), "Prior")) Then

                        InPut_Array(25, i) = "Payment"
                        InPut_Array(26, i) = "Repair Order"

               ElseIf Len(InPut_Array(20, i)) = 7 And IsNumeric(InPut_Array(20, i)) _
               And (InStr(InPut_Array(15, i), "Prior") Or InStr(InPut_Array(15, i), "Current")) _
               And InPut_Array(19, i) < 0 Then

                        InPut_Array(24, i) = "RO/Accr Adj."
                        InPut_Array(25, i) = "Reversing Entry"
               End If

        'Case 2 : GL/Date is between the first day of the month and the last day of the month
        ElseIf (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1) < InPut_Array(15, i) < WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
                'Looking for payments MidMonth (i.e. after the FirstDay_CurrMon _
                but before LastDayCurrMont
                If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 _
                And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
                And Not (InStr(InPut_Array(16, i), "Prior")) Then

                        InPut_Array(25, i) = "Payment"
                        InPut_Array(26, i) = "Repair Order"

                        'Write PO Num
                        OutPut_Array(1, i) = InPut_Array(21, i)
                        'Print the first day of the current month's date
                        OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
                        'Print the Amount
                        OutPut_Array(3, i) = Abs(InPut_Array(20, i))

                End If

        'Case 3.1 and 3.2: If GL/Date is on the last of the month
        ElseIf InPut_Array(15, i) = WorksheetFunction.EoMonth(InPut_Array(15, i), 0) Then
                If Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) _
                And (InStr(InPut_Array(16, i), "Prior") Or InStr(InPut_Array(16, i), "Current")) _
                And InPut_Array(20, i) < 0 Then

                        InPut_Array(25, i) = "RO/Accr Adj."
                        InPut_Array(26, i) = "Repair Order"

                        'Write PO Num
                        OutPut_Array(1, i) = InPut_Array(21, i)
                        'Print the first day of the current month's date
                        OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
                        'Print Amount
                        OutPut_Array(3, i) = Abs(InPut_Array(20, i))

                'If criteria met for payment on the last day of the Current Month _
                then do the same as payments for MidMonth
                ElseIf Len(InPut_Array(21, i)) = 7 And IsNumeric(InPut_Array(21, i)) And InPut_Array(20, i) > 0 _
                And (InPut_Array(16, i) = InPut_Array(17, i) Or InStr(InPut_Array(16, i), "Reclas") Or InStr(InPut_Array(16, i), "*Req Adj*")) _
                And Not (InStr(InPut_Array(16, i), "Prior")) Then

                        InPut_Array(25, i) = "Payment"
                        InPut_Array(26, i) = "Repair Order"

                        'PO Num
                        OutPut_Array(1, i) = InPut_Array(21, i)
                        'Print the first day of the current month's date
                        OutPut_Array(2, i) = DatePart("d", (InPut_Array(15, i) - Day(InPut_Array(15, i)) + 1))
                        'Print Amount
                        OutPut_Array(3, i) = Abs(InPut_Array(20, i))
                End If
        End If
    Next i

    '***************************
    'Dictionary Implementation 
    Set Dict = New Dictionary 'Early Binding

    'populate dictionary with composite keys from output array
    For y = LBound(OutPut_Array, 2) To UBound(OutPut_Array, 2)
        k = Join(Array(OutPut_Array(1, y), _
                       OutPut_Array(2, y), _
                       OutPut_Array(3, y)), "~~")
        Dict(k) = True
    Next y

    'compare...
    For x = LBound(ShtInPut_Array, 1) To UBound(ShtInPut_Array, 1)

        k = Join(Array(ShtInPut_Array(x, 21), _
                       DatePart("d", ShtInPut_Array(x, 15)), _
                       Abs(ShtInPut_Array(x, 20))), "~~")

        If Dict.Exists(k) Then
            ShtInPut_Array(x, 25) = "RO/Accr Adj."
            ShtInPut_Array(x, 26) = "Repair Order"
        End If

    Next x
    '***************************

        Sheet17.Range("A2").Resize(UBound(ShtInPut_Array, 1), UBound(ShtInPut_Array, 2)) = ShtInPut_Array

    'Note for those who were curious as _ 
     to why I did't Set Application.ScreenUpdating = True _ 
     It's b/c Excel does so automatically, so not doing so _ 
     pro-grammatically saves a bit of speed  
    Application.EnableEvents = True

End Sub

```