Hallo zusammen,

ich habe wieder mal ein VBA-Problem. Ich suche in Spalte A nach einem doppelten Wert und möchte in dieser Zeile dann die Zelle in Spalte B gelb einfärben.

Folgenden Codeausschnitt habe ich geschrieben, der auch durchläuft, aber nichts einfärbt. Die jeweiligen Suchkrieterien werden jedoch korrekt gefunden.

Für jeden Tip im Voraus vielen Dank,

Liebe Grüße

Thomas

If letzteZeile_filter <> lngZeilemax_Master Then

    MsgBox ("Achtung! Anzahl der Material Group und Anzahl Complaints sind nicht gleich!")
    
    If letzteZeile_filter > lngZeilemax_Master Then
        Worksheets("Material Information").Range("A:A").SpecialCells(xlCellTypeVisible).Copy  'Kopiere nur sichtbare Zellen aus Spalte A  in Tabelle5
        Worksheets("tabelle1").Range("A:A").PasteSpecial (xlPasteValuesAndNumberFormats)
        Worksheets("Material Information").ShowAllData

       With Worksheets("tabelle1")
        lngzeilemax_tabelle1 = .Cells(.Rows.Count, 1).End(xlUp).Row
    
        Set objDic = CreateObject("Scripting.dictionary") 'Setze Objekt Dictionary zur Ermittlung der doppelten Datensätze.
    
        For Each rngZelle In .Range("A2:A" & lngzeilemax_tabelle1)
    
            If rngZelle <> "" Then
                If objDic.exists(rngZelle.Value) = False Then   'Wenn Rec-ID noch nicht in Dictionary-Objekt vorhanden ist (0)
                    objDic(rngZelle.Value) = 0
                
                Else
                    lngDopp = lngDopp + 1                       'Wenn vorhanden, dann erhöhe Variable lngdopp um 1, um später die Referenz zu korrigieren.
                    strdopp = strdopp & rngZelle.Value & vbLf       'Abspeichern der doppelten Rec-IDs in Stringvariable strdopp
                    strRecID = rngZelle.Value
                    
                    Set RaFound = Worksheets("Material Information").Range("A:A").Find(strRecID, LookIn:=xlValues)
                    If Not RaFound Is Nothing Then
                    lngZeile = RaFound.Rows
                    Worksheets("Material Information").Cells(lngZeile, 2).Interior.Color = RGB(255, 255, 0)
                    Workbooks("query_export_results.csv").Worksheets("query_export_results").Cells(i, 1).Interior.Color = RGB(255, 255, 0)
                    MsgBox RaFound.Row
                    'Rows(RaFound.Row).Delete
                    Set RaFound = Nothing
                    End If
                    
                    
                    'Strdoppaddress = rngZelle.Address
                    'MsgBox (Strdoppaddress)
                End If
                
                
            End If
          
        Next rngZelle
        End With
        MsgBox (lngDopp & " Record-IDs beinhalten in Spalte ""Primary"" mehr als ein "" Yes""!" & vbCrLf & strdopp)
            
    End If
    
    
End If