Duplicaten vinden en vorm tekst wijzigen + msgbox weergeven

[tonissteiner]

Hallo forumgebruikers,

ik had graag hulp bij het aanpassen van volgende code:

Sub FindDuplicatesInColumn()
    
    Dim r As Range, c As Range, s As String
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    For Each c In r
        If WorksheetFunction.CountIf(r, c) > 1 Then If InStr(1, s, c) = 0 Then s = s & vbCr & c
    Next
    
    MsgBox IIf(s <> "", "Volgende duplicaten werden gevonden:" & vbLf & s, "Geen duplicaten gevonden!"), vbInformation, "Duplicaten"

    'With s.Characters.Font
    '        .Bold = True
    '        .Size = 14
    '        .Color = vbMagenta
    'End With

End Sub

Deze code vindt de duplicaten in een bepaald celbereik en geeft de gevonden waarden weer in een msgbox.
Ik heb de code zelf proberen aanpassen zodat in de dubbele cellen de font ook nders weergegeven zou worden. Dit lukt me echter niet. Wat ik probeerde heb ik gecommentarieerd.

Graag jullie hulp.

alvast bedankt en mvg,

Stefan

 

[edmoor]

Wizjig s.Characters.Font eens in c.Characters.Font
Maar dan wel binnen de For Each.

 

[JEC.]

Ik zou hier toch gaan voor de ingebouwde functie van Excel dmv VO

 

[tonissteiner]

Dag Edmoor,

als ik het goed begrijp bedoel je dit dan:

Sub FindDuplicatesInColumn()
    
    Dim r As Range, c As Range, s As String
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    For Each c In r
        If WorksheetFunction.CountIf(r, c) > 1 Then If InStr(1, s, c) = 0 Then s = s & vbCr & c
    
            With s.Characters.Font
                .Bold = True
                .Size = 14
                .Color = vbMagenta
            End With
        Next
    
    MsgBox IIf(s <> "", "Volgende duplicaten werden gevonden:" & vbLf & s, "Geen duplicaten gevonden!"), vbInformation, "Duplicaten"

End Sub

Echter met deze lijnen te verplaaten worden alle fonts gewijzigd. Ik wou enkel de dubbele lijnen wijzigen

 

[tonissteiner]

Dag JVeer,

wat bedoel je met VO?

 

[edmoor]

@#4:
Uiteraard moet je dat ook binnen die If controle opnemen.

 

[JEC.]

Voorwaardelijke opmaak en dan vervolgens dubbele waarden laten oplichten

 

[tonissteiner]

Hallo JVeer, de VO is geen optie in mijn document. ik had deze code willen integreren in een document waar ik met bezig ben. toch bedankt voor de tip

 

[tonissteiner]

Dag Edmoor, met jouw tip ben ik wat aan het uitproberen waar ik die moet plaatsen. zo heel veel ken ik niet van VBA dus is het meer trial and error voor mij.
Jullie lezen deze codes waarschijnlijk zoals jullie een boek of strip lezen. voor mij is het een zoals een Chinees boek lezen.
Ik probeer nog wel even verder in de hoop dat ik alles netjes op de juiste plaats in de code kijg

 

[edmoor]

Zonder je document kan ik het niet testen en JVeer zijn voorstel ook niet.

 

[tonissteiner]

Goede morgen Edmoor,

ik ben zelf al stapje dichter geraakt met deze code:

Sub FindDuplicatesInColumn()
    
    Dim r As Range, c As Range, s As String
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    For Each c In r
        If WorksheetFunction.CountIf(r, c) > 1 Then
            With c.Characters.Font
                .Bold = True
                .Size = 14
                .Color = vbMagenta 
            End With
        End If
      
        If InStr(1, s, c) = 0 Then s = s & vbCr & c
    Next
    
    MsgBox IIf(s <> "", "Volgende duplicaten werden gevonden:" & vbLf & s, "Geen duplicaten gevonden!"), vbInformation, "Duplicaten"
     
End Sub

Echter worden nu in de msgbox de lijnen weergegeven die geen duplicaten bevatten in plaats van omgekeerd.

Alvast bedankt om hier even te willen naar kijken.

mvg,

Stefan

 

[tonissteiner]

Hoe stom van mij!
gisteren was het te laat, deze morgen te vroeg. Vandaag overdag dus even kunnen nadenken.
Stelde mezelf de vraag, wat is het tegenovergestelde van verschillend (<>)? Gelijk aan (=) natuurlijk

Code werkt dus:

Sub FindDuplicatesInColumn()
    
    Dim r As Range, c As Range, s As String
    Set r = Range("A1", Range("A" & Rows.Count).End(xlUp))
    
    For Each c In r
        If WorksheetFunction.CountIf(r, c) > 1 Then
      With c.Characters.Font
        .Bold = True
        .Size = 14
        .Color = vbMagenta
    End With
    End If
      
        If InStr(1, s, c) = 0 Then s = s & vbCr & c
    Next
    
    
    MsgBox IIf(s = "", "Volgende duplicaten werden gevonden:" & vbLf & s, "Geen duplicaten gevonden!"), vbInformation, "Duplicaten"
     

End Sub

Bedankt voor alle tips.

mvg,

Stefan