Find match med dubletter

Jeg har en makro der tjekker for ens værdier i to separate kolonner, hvor jeg bruger "for each - metoden".

Den fungerer på den måde, at der først tjekkes for korrekt dato, derefter om et beløb i kolonne F (udgangskolonne) findes i kolonne D (compareRange).
Hvis beløbet findes, sættes der et kryds i cellen til højre for beløbet i kolonne F.

Altså er der tale om en egentlig afstemning af beløb.

Det fungerer fint, så længe der ikke er dubletter i udgangskolonnen.
Hvis den samme værdi forekommer flere gange her, men kun én gang i compareRange, så bliver der alligevel sat et kryds til højre for de værdier der matcher.

Eksempel:
Beløbet 100 forekommer 2 gange i udgangskolonnen, men kun én gang i compareRange.
Makroen sætter alligevel et kryds til højre for begge beløb (100) i udgangskolonnen. Hvilket der jo ikke skal, da beløbet mangler én gang i compareRange.

Er der nogen der har et bud på hvordan jeg ændre i makroen, så den tager højde for at der kan forekomme dubletter?

Eller måske er der en helt anden metode til at tjekket for match med dubletter?


På forhånd tak

Laugesen


Koden:

Sub FindMatchTest()

Dim CompareRange1 As Variant, X As Variant, Y As Variant
Dim Dato As Date


Set CompareRange1 = Application.ThisWorkbook.Sheets("Ark3").Range("D4:D23")

Dato = Sheets("Ark3").Range("A2").Value

        Range("F4:F23").Select
       
        For Each X In Selection
            For Each Y In CompareRange1
       
If Y.Value > 0 And Y.Offset(0, -1).Value = DateValue(Dato) And Y = X Then x.Offset(0, 1) = "x"
 
        Next Y
            Next X

                End Sub