Find et par (nærmeste)

Jeg skal ikke kunne sige om den opfører sig som du ønsker i alle henseender, men den virker på de to eksempler du har opgivet. Håber du kan følge mig.

Sub FindPar()

    Dim i, C1, C2, A, B As Integer

C1 = Ark1.Range("c1").Value
C2 = Ark1.Range("c2").Value


Sheets("ark1").Activate

For i = 1 To Ark1.Range("A50").End(xlUp).Row
A = Cells(i, 1).Value
B = Cells(i, 2).Value

        If ((C1 + C2) - (Ark1.Range("d1").Value + Ark1.Range("d2").Value)) < ((A + B) - (C1 + C2)) Then
        Exit Sub
        End If

        If Cells(i, 1).Value >= C1 And Cells(i, 2).Value <= C2 Then
        Ark1.Range("d1").Value = Cells(i, 1).Value
        Ark1.Range("d2").Value = Cells(i, 2).Value
        End If
       
Next
End Sub

D1 og D2 er nul til at starte med...

Du kan evt indsætte:

Ark1.Range("d1").Value = 0
Ark1.Range("d2").Value = 0

Over "For"-sætningen, så vil den selv nulstille, hver gang du kører makroen.

Super - Har fået det til at virke i mit program -
Sidder og leger med om jeg selv kan finde ud af at komme med en besked hvis den ikke finder et matchet par.
Vil du ha lidt points ? - Så kan med et indlæg som svar. )

Hermed et svar. Ang. din besked (har ikke testet!), er det så ikke bare at indsætte en "msgbox" til allersidst, hvis den finder et match, så exiter den jo....

Lukker du dette spørgsmål?