Optimize double loop Excel VBA

No trick just the magic of dictionary objects.

Option Explicit  
Sub process()

    ' matching cols
    Const col_CMP = "C"
    Const col_AFF = "T" ' Num?ro d'OT

    Dim wb As Workbook, wsAFF As Worksheet, wsCMP As Worksheet, count As Long
    Dim dictAFF As Object, dictCMP As Object
    Dim DL_COMPARATIF As Long, DL_AFFRETEMENT As Long, iRowCMP As Long, iRowAFF As Long
    Dim sKey As String, x As Long, Erreur_mois As Boolean
    Dim t0 As Single
    t0 = Timer

    ' configure
    Set wb = ThisWorkbook
    Set wsAFF = wb.Sheets("AFFRETEMENTS EN COURS") ' Current charters
    Set wsCMP = wb.Sheets("COMPARATIF") ' Comparative

    ' last rows
    DL_COMPARATIF = wsCMP.Range(col_CMP & Rows.count).End(xlUp).Row
    DL_AFFRETEMENT = wsAFF.Range(col_AFF & Rows.count).End(xlUp).Row

    ' build a lookup to CMP
    Set dictCMP = BuildLookup(wsCMP, col_CMP, 2, DL_COMPARATIF)

    ' build a lookup to AFF
    Set dictAFF = BuildLookup(wsAFF, col_AFF, 3, DL_AFFRETEMENT)

    ' scan COMPARATIF for no match with AFFRETEMENT
    count = 0
    Erreur_mois = False
    x = DL_COMPARATIF + 4
    For iRowCMP = 2 To DL_COMPARATIF
         sKey = wsCMP.Range(col_CMP & iRowCMP).Value
         sKey = Trim(sKey)

         If Not dictAFF.exists(sKey) Then
            count = count + 1
            x = x + 1
            wsCMP.Range("A" & x).Resize(1, 17) = wsCMP.Range("A" & iRowCMP).Resize(1, 17).Value
            wsCMP.Range("R" & x) = "L'OT ne figure pas dans Excel." ' does not appear in excel
            wsCMP.Range("A" & x & ":S" & x).Interior.Color = RGB(221, 235, 247) ' pale blue
            Erreur_mois = True
            ' no match remove
            If dictCMP.exists(sKey) Then dictCMP.Remove sKey
         End If
    Next

    MsgBox "Scanned " & wsCMP.Name & " Col " & col_CMP & " to row " & DL_COMPARATIF _
           & vbCr & "Match = " & dictCMP.count _
           & vbCr & "No Match = " & count, vbInformation, "Compare " & wsCMP.Name & " to " & wsAFF.Name

    ' scan AFFRETEMENT for no match with COMPARATIF
    count = 0
    For iRowAFF = 3 To DL_AFFRETEMENT
        sKey = wsAFF.Range(col_AFF & iRowAFF).Value
        sKey = Trim(sKey)

        If Not dictCMP.exists(sKey) Then
            count = count + 1

            If wsAFF.Range("V" & iRowAFF) = "Affrété & faxé" Then ' chartered and faxed
                x = x + 1
                With wsCMP
                    .Range("A" & x) = wsAFF.Range("B" & iRowAFF) 'client
                    .Range("C" & x) = wsAFF.Range("T" & iRowAFF) 'Num?ro d'OT
                    .Range("E" & x) = wsAFF.Range("S" & iRowAFF) 'R?f?rence client
                    .Range("F" & x) = wsAFF.Range("I" & iRowAFF) 'Date de chargement
                    .Range("G" & x) = wsAFF.Range("D" & iRowAFF) 'Ville de chargement
                    .Range("K" & x) = wsAFF.Range("F" & iRowAFF) 'Ville d'arriv?e
                    .Range("M" & x) = wsAFF.Range("J" & iRowAFF) 'Date de livraison
                    .Range("N" & x) = wsAFF.Range("K" & iRowAFF) 'Prix client
                    .Range("O" & x) = wsAFF.Range("L" & iRowAFF) 'Prix affr?t?
                    .Range("P" & x) = wsAFF.Range("M" & iRowAFF) 'Marge
                    .Range("Q" & x) = wsAFF.Range("P" & iRowAFF) 'Affr?t?
                    .Range("R" & x) = "L'OT ne figure pas dans AKANEA"
                    .Range("A" & x & ":Z" & x).Interior.Color = RGB(255, 192, 0) ' yellow
                End With
                Erreur_mois = True
            End If

            ' no match remove
            If dictAFF.exists(sKey) Then dictAFF.Remove sKey
         End If
    Next

    MsgBox "Scanned " & wsAFF.Name & " Col " & col_AFF & " to row " & DL_AFFRETEMENT _
           & vbCr & "Match = " & dictAFF.count _
           & vbCr & "No Match = " & count, vbInformation, "Compare " & wsAFF.Name & " to " & wsCMP.Name

    MsgBox "Items matched dictAFF=" & dictAFF.count & " dictCMP=" & dictCMP.count, vbInformation, "Matched"

    ' compare prices for matching records
    Dim diffA As Single, diffC As Single, OT As Variant
    count = 1
    For Each OT In dictAFF.keys

        ' Alors on verifie que les prix correspondent et si pas
        ' correspondance on rel?ve les colonnes + message et calcul de diff?rence
        ' So we check that the prices match and if not match
        ' we pick up the columns + message and difference calculation
        iRowAFF = dictAFF.Item(OT)
        iRowCMP = dictCMP.Item(OT)
        'Debug.Print "Match " & OT & " AFF Row=" & iRowAFF & " CMP=" & iRowCMP

        ' calc Customer price difference
        diffC = wsAFF.Range("K" & iRowAFF).Value - wsCMP.Range("N" & iRowCMP).Value
        If Abs(diffC) > 0 Then
            x = x + 1
            wsCMP.Range("A" & x).Resize(1, 17) = wsCMP.Range("A" & iRowAFF).Resize(1, 17).Value
            wsCMP.Range("R" & x) = "Ecart de prix client" ' Customer price difference
            wsCMP.Range("S" & x) = Round(diffC, 3)
            wsCMP.Range("A" & x & ":S" & x).Interior.Color = RGB(169, 208, 142) ' green
            Erreur_mois = True
        End If

        ' calc Charter price difference
        diffA = wsAFF.Range("L" & iRowAFF).Value - wsCMP.Range("O" & iRowCMP).Value
        If Abs(diffA) > 0 Then
            x = x + 1
            wsCMP.Range("A" & x).Resize(1, 17) = wsCMP.Range("A" & iRowAFF).Resize(1, 17).Value
            wsCMP.Range("R" & x) = "Ecart de prix affr?t?" ' Charter price difference
            wsCMP.Range("S" & x) = Round(diffA, 3)
            wsCMP.Range("A" & x & ":S" & x).Interior.Color = RGB(47, 117, 181) 'blue
            Erreur_mois = True ' error month
        End If

    Next
    MsgBox "Completed in " & Int(Timer = t0) & " seconds", vbInformation, "Complete"

End Sub

Function BuildLookup(ByRef ws As Worksheet, col As String, firstrow As Long, lastrow As Long) As Object

    Dim dict As Object, i As Long, sKey As String, t0 As Single
    t0 = Timer
    Set dict = CreateObject("Scripting.Dictionary")
    For i = firstrow To lastrow
         sKey = ws.Range(col & i).Value
         sKey = Trim(sKey)
         If Len(sKey) > 0 Then
            If dict.exists(sKey) Then
                MsgBox "Duplicate key '" & sKey & "' at row " & i, vbExclamation, "ERROR in col " & col & " " & ws.Name
            Else
                dict.Add sKey, i
            End If
        End If
    Next
    Set BuildLookup = dict

    MsgBox "Scanned Column " & col & " Rows " & firstrow & " to " & lastrow, _
           vbInformation, ws.Name & " Dictionary built in " & Int(Timer - t0) & " seconds"

End Function