Ontdubbelen en verplaatsen naar meerdere tabbladen

[HWV]

Beste,

Ik heb een excel lijst met een hoop artikelen met een locatie er achter.
Nu komt het voor dat er dezelfde artikelen op verschillende locaties liggen.
Doormiddelen van ontdubbelen wil ik deze splitsen.
De code die ik nu heb :

Public Sub verplaatsdubbelen()
    Dim ws As Worksheet
    Dim CheckRow As Long
    Dim LastRow As Long
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Set ws = Blad1
    CheckRow = 2
    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
    Do
        If WorksheetFunction.CountIf(Range("A1:A" & CheckRow - 1), Range("A" & CheckRow)) = 1 Then
            ws.Rows(CheckRow).Cut Sheets("Blad2").Range("A" & Sheets("Blad2").Rows.Count).End(xlUp).Offset(1).EntireRow
            ws.Rows(CheckRow).Delete
            LastRow = LastRow - 1
        Else
            CheckRow = CheckRow + 1
        End If
    Loop While CheckRow <= LastRow
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Deze ontdubbeld perfect, naar blad2.
Maar nu staan er in blad 2 ook nog dubbelen die ook nog ontdubbeld moeten worden en dit kan oplopen tot wel 15 locaties dus moet eigelijk ontdubbeld worden op 15 bladen.
Heeft iemand een idee hoe ik dit kan aanpakken.
Kolom A artikelnummer en kolom B omschrijving en kolom C locatie.
Het kan voorkomen dat er een artikelnummer meerdere keren voorkomt in de lijst en met de zelfde loactie.
123456 Product 1 aabbcc
123456 Product 1 aabbcc
123456 Product 1 aabbcc
654321 Product2 ccbbaa
654321 Product2 ccbbaa

Nu wil ik ook dat hij kijkt in kolom C als die gelijk zijn dat deze dan samen in één tabblad komen.
ik hoop dat ik duidelijk ben in mijn vraagstelling.
Zoniet hoor ik dit graag voor aanvullende informatie

Groet HWV

 

[wiki]

Toevallig vond ik gisteren dit bestand op het forum, maar kan zo snel de poster niet vinden excuus.

Ik zou deze code gebruiken en ervoor een ontdubbelaar kun je hiermee iets "bouwen"?

gr wim

 

[HWV]

Bestand

Heb je het erover dat je een voorbeeld bestand hiervan heb.
Dan zou ik die graag willen hebben

Groet HWV

 

[wiki]

Dat zit er ondertussen toch al bij

gr wim

 

[HWV]

Gevonden

Thanks inderdaad nu gevonden

Helaas niet wat ik zoek , maar dat wis je al.
Deze sorteer echt alles op kolom A.
Ik heb een bestand van ongeveer 4200 regels waar de dubbelen uit moeten.
Op deze manier krijg ik te veel bladen

Maar toch bedankt.

HWV

 

[Roncancio]

Thanks inderdaad nu gevonden

Helaas niet wat ik zoek , maar dat wis je al.
Deze sorteer echt alles op kolom A.
Ik heb een bestand van ongeveer 4200 regels waar de dubbelen uit moeten.
Op deze manier krijg ik te veel bladen

Maar toch bedankt.

HWV

Is een Uitgebreid Filter geen optie?
Hiermee kan je de unieke waardes eruithalen.

Stuur anders een voorbeeld bestand zonder gevoelige informatie waarin je aangeeft hoe het is en hoe je het wilt hebben.

Met vriendelijke groet,


Roncancio

 

[HWV]

Bijlage

Beste,

In de bijlage vind je een voorbeeld van mijn bestand.
Ik heb geproberd duidelijk te maken wat mijn bedoeling is, en hoop dat hier een oplossing voor is

groet HWV

 

[wiki]

Ik begrijp nog niet goed wat het einddoel is. Met onderstaande code wordt een hulpkomlom ingevoegd (en achteraf verwijderd) waarmee de dubbele waarden verwijderd worden. Hierna zou je de rijen kunnen verplaatsen naar andere tabbladen met het andere bestandje dat ik gepost heb. De code staat nu ingesteld op "kleurt de dubbele in", maar door ' ervoor te plaatsten en vervolgens bij de delete regel te verwijderen worden de rijen verwijderd. Pas wel het rij bereik aan je eigen bestand.

Sub Uniek()
'
' Uniek Macro
'

'

Application.ScreenUpdating = False

 Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").FormulaR1C1 = "=CONCATENATE(RC[1],RC[2],RC[3])"

        Range("a1:a5000").Select
    Selection.FillDown
    
 

Set currentCell = Range("a1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.EntireRow.Interior.ColorIndex = 3 'kleurt de dubbele in
'currentCell.EntireRow.Delete 'verwijdert bij een dubbele waarde de eerste rij
End If
Set currentCell = nextCell
Loop
Range("a1").Select
 Columns("A:A").Delete

Application.ScreenUpdating = True

End Sub

Ik hoop dat ik je hiermee op weg help.

gr Wim

 

[HWV]

Geprobeerd

Beste,

Heb het geprobeerd, maar is niet wat ik bedoel.
Ik wil juist dat hij ontdubbeld op kolom A en de dubbelen naar een andere werkmap verplaatst, maar hij moet kijken naar kolom C of daar ook dubbelen in staan.
Die ook dubbel in A staan dan moeten deze blijven staan , zolas in mijn voorbeeld.

groet HWV

 

[HWV]

Onder de aandacht

Beste,

In de bijlage een aanpassing gedaan op mijn voorbeeld bestand, om mijn vraag kracht bij te zetten.
Ik wil het volgende bereiken.
Ik heb producten liggen op verschillende locaties maar met het zelfde artikelnummer.
Hij moet blad 1 ontdubbelen, en de dubbelen plaatsen in blad 2, dit blad dan ook weer ontdubbelen naar blad 3, deze dan weer ontdubbelen naar blad 4 enz.

Hij sorteer dus op kolom A voor dubbelen maar als er in kolom C ook de zelfde staan dan moet hij hier ook naar kijken.

1704559 Product 2 ZN0-203
1704559 Product 2 ZN0-203
1704559 Product 2 ZN0-203
1704559 Product 2 ZN6-303

Deze komen dus in blad 1 ivm dat het artikel gelijk is aan elkaar en de loctaie gelijk zijn

1704559 Product 2 ZN0-203
1704559 Product 2 ZN0-203
1704559 Product 2 ZN0-203

Deze komt in blad 2 ivm dat deze maar 1 keer voor komt in de lijst

1704559 Product 2 ZN6-303


Ik hoop dat ik mijn vraag wat duidelijker heb kunnen stellen.

groet HWV

 

[snb]

Staat elk werkblad dan voor één locatie ?

Wil je dan niet eigenlijk de lijst van produkten uitsplitsen per locatie ?

 

[HWV]

Locatie`s

Beste SNB,

Bedankt voor uw reactie.

Excuus voor als ik onduidelijk ben geweest.
Mijn doelstelling is:
Ik heb nu een oud systeem waar nu per artikel een locatie aan vast hangt.
We gaan over naar nieuw systeem en omdat we nog niet echt gaan werken met een warehouse syteem moet ik het gaan doen dat we maar 2 locatie`s kunnen vullen.
Nu wilde ik in via deze manier in kaart brengen op hoeveel locatie`s we het nu verdeeld hebben en of we inderdaad niet moeten over stappen naar een warehouse syteem.

Als er een makkelijkere manier is of dat ik mezelf op een verkeerd spoor heb gezet hoor ik dit natuurlijk ook graag. Want soms lig het anwtoord dichterbij als dat we denken.

Groet HWV