Option Explicit
Sub SpaltenDuplikate()
Dim rngSpalte As Range
Set rngSpalte = FrageSpalte
If rngSpalte Is Nothing Then Exit Sub
Rem *****************************************************************************
Rem setze FormatConditions und Ruhe ist !
Rem eine "cells.FormatConditions.Delete" - Zeile am Anfang putzt das ganze Blatt
Rem *****************************************************************************
With rngSpalte.FormatConditions
.Delete
.AddUniqueValues
End With
With rngSpalte.FormatConditions(1)
.DupeUnique = xlDuplicate
.Interior.Color = RGB(0, 255, 0)
.StopIfTrue = False
End With
End Sub
Rem ****************************************************************************
Rem um den "lästigen" Anwender-Eingabefehler zu vermeiden
Rem benutzt die Funktion die Application.InputBox - Methode
Rem vom angeklickten Bereich zu dessen Spalte
Rem und nur Zellen <> "leer", denn kein Blatt ist bis zur letzten Zeile ........
Rem ****************************************************************************
Private Function FrageSpalte() As Range
Dim c As Range
On Error Resume Next
Set c = Application.InputBox( _
prompt:="Klicke beliebig in Spalte wo ...", _
Title:="Eingabe durch Mausklick", _
Default:=Cells(1, ActiveCell.Column).Address, _
Type:=8)
Set FrageSpalte = Columns(c.Column).ColumnDifferences _
(Comparison:=Range(Cells(Rows.Count, c.Column).Address))
On Error GoTo 0
End Function