Unieke namen

[AatB]

Hallo Forum,

Ik heb het volgende probleem;

In kolom A staan namen, bijvoorbeeld Jan, Piet, Klaas, Klaas, Peter, Piet.
Ik wil de unieke namen in kolom B krijgen.
Als ik nu een nieuwe naam in kolom A toevoeg, dan moet deze ook toegevoegd worden aan kolom B. Als een naam uit kolom A verwijderd wordt, heeft dit geen gevolgen voor de namen in kolom B.

Weten jullie een oplossing?

mvg,

Aat

 

[snb]

sub uniek()
  columns(1).specialcells(xlcelltypeconstants).advancedfilter xlfiltercopy,[A1],[B1],true
End Sub

Ik ga ervan uit dat in Cel A1 de titel van dit veld ('naam' bijvoorbeeld) staat.

 

[AatB]

sub uniek()
  columns(1).specialcells(xlcelltypeconstants).advancedfilter xlfiltercopy,[A1],[B1],true
End Sub

Ik ga ervan uit dat in Cel A1 de titel van dit veld ('naam' bijvoorbeeld) staat.

Bijna goed......
Als in kolom a een waarde niet meer staat die er voorheen wel stond, raak ik deze nu ook in kolom b kwijt en dat was nou net niet de bedoeling.....

Aat

 

[Ginger]

AatB, Niet zo kort als de code van snb, maar 't doet wel wat je wilt...

Sub Uniek()
Dim c As Range

    For Each c In Columns(1).SpecialCells(xlCellTypeConstants)
        If Columns(2).Find(c.Value) Is Nothing Then
            Cells(Rows.Count, 2).End(xlUp).Offset(1).Value = c.Value
        End If
        Next c

End Sub

Bij het verwijderen van een naam uit kolom A en het draaien van de code, zal kolom B onaangetast blijven. (al vraag ik me wel af waarom je die naam nog wilt houden in kolom B...)

Groet, Leo

 

[snb]

Zo beter ?

Sub uniek()
  Columns(2).SpecialCells(2).Copy Cells(Columns(1).SpecialCells(2).Count + 1, 1)
  Columns(1).SpecialCells(2).AdvancedFilter xlFilterCopy, , [B1], True
End Sub

 

[AatB]

Zo beter ?

Sub uniek()
  Columns(2).SpecialCells(2).Copy Cells(Columns(1).SpecialCells(2).Count + 1, 1)
  Columns(1).SpecialCells(2).AdvancedFilter xlFilterCopy, , [B1], True
End Sub

Leo,
die van jou doet het uitstekend...bedankt....:thumb:

SNB,
ook bedankt, maar je macro doet het niet goed.....


Groet,

Aat