Regel met laatste datum behouden

Status
Niet open voor verdere reacties.

Peter2016

Gebruiker
Lid geworden
4 sep 2015
Berichten
89
Hallo,

Ik zou graag van bijgaand bestand, alleen de regel willen behouden met de laatste datum, als de waarde van kolom A,C,D gelijk zijn.
Dus de regels waarvan de datum voor het gemak oranje is, die moet over blijven.

Alvast bedankt.Bekijk bijlage Laatste Datum.xlsm
 
Het zal met een stuk minder code moeten kunnen, maar dit is wat ik er van kan maken.

Code:
Sub ABCD()

Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

Application.ScreenUpdating = False


    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "A2:A111"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "C2:C111"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "D2:D111"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "H2:H111"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Overzicht").Sort
        .SetRange Range("A1:H111")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For X = LastRow To 2 Step -1

If Range("A" & X).Value = Range("A" & X + 1).Value And Range("C" & X).Value = Range("C" & X + 1).Value And Range("D" & X).Value = Range("D" & X + 1).Value Then Range("A" & X).EntireRow.Delete

Next

Application.ScreenUpdating = True

End Sub
 
Geweldig Sjon, doet precies wat ie moet doen, ik ga 'm straks op mijn data bestand zetten. Heb er vol vertrouwen in.
Bedankt voor je hulp :)
 
Niet vergeten je sorteerbereik aan te passen :)
 
Ohh Sjon, Hij is nu geschreven tot regel 111 zie ik, maar de code wordt losgelaten op een variabel aantal regels ( elke keer weer een ander aantal, dus hij moet gewoon naar de laatste waarde in kolom A zoeken, dit is dan de laatste regel). Is daar nog wat op aan te passen?
Sorry dat ik dat niet meteen heb verteld.
 
Ja, is wel beter ja.

Code:
Sub ABCD()

Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

Application.ScreenUpdating = False


    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "C2:C" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "D2:D" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Overzicht").Sort.SortFields.Add Key:=Range( _
        "H2:H" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Overzicht").Sort
        .SetRange Range("A1:H" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For X = LastRow To 2 Step -1

If Range("A" & X).Value = Range("A" & X + 1).Value And Range("C" & X).Value = Range("C" & X + 1).Value And Range("D" & X).Value = Range("D" & X + 1).Value Then Range("A" & X).EntireRow.Delete

Next

Application.ScreenUpdating = True

End Sub
 
En dat maakt mij vervolgens weer blij! :thumb:
 
Of:
Code:
Sub hsv()
With Sheets("overzicht").Cells(1).CurrentRegion.Resize(, 8)
      .Sort [a1], , [h1], , 2, , , 1
      .RemoveDuplicates Array(1, 3, 4)
 End With
End Sub
 
Laatst bewerkt:
Harry,

Lekker kort, zoals altijd! Zou je een beetje uitleg kunnen geven over de code. Het werkt als een tierelier, maar kan het niet echt doorgronden. Na de eerste regel ben ik je kwijt :confused:

Het begint een beetje te dagen denk ik.

.Sort = Key1, leeg,want ascending is default, Key2,leeg, want type is default op values ??, 2 (dit moet dan descending zijn, vermoed ik, Key3(leeg, dus niet),dus ook leeg , Header = yes

Zit ik in de buurt?

Gr.

Sjon
 
Laatst bewerkt:
@SjonR,

Hoewel ik geen Harry heet toch een antwoord op jouw vraag;) De interpretatie van de range.sort methode heb je volgens mij goed. Deze methode heeft de beperking dat je maar op drie kolommen kan sorteren. En dat is in dit voorbeeldbestand ook minimaal nodig om het goed te laten gaan. De code van HSV gaat goed omdat de TS een verkeerd voorbeeld heeft geplaatst waar al een sortering inzit en het verwachte resultaat niet klopt met de vraag. Dick heeft twee verschillende 'nummers' achter zijn naam staan (R045BAX065B en R045BAX066B)

Met 3 kolommen gaat het in het voorbeeld wel goed.
Code:
.Sort [A1], , [D1], , , [H1], 2, xlYes

Jouw idee om op de vier kolommen te sorteren is waarschijnlijk nog beter maar kan je wel wat vereenvoudigen.
Code:
Sub VenA()
  With Sheets("Overzicht").Sort
    .SortFields.Clear
    .SortFields.Add [A1], , 2
    .SortFields.Add [C1]
    .SortFields.Add [D1]
    .SortFields.Add [H1], , 2
    .SetRange .Parent.Cells(1).CurrentRegion.Resize(, 8)
    .Header = xlYes
    .Apply
  End With
End Sub
(Kolom A even omgekeerd gesorteerd zodat je kan zien dat ook hier mee te spelen is.)

Dat het verwijderen via het geavanceerde filter iets sneller gaat dan het rij voor rij verwijderen lijkt mij logisch.
 
De sortering op twee kolommen is voldoende icm removeduplicates 1,3,4 ;)

Ps. Op alleen kolom H lijkt mij ook al voldoende.
De namen staan alleen wat door elkaar in het resultaat.
 
Laatst bewerkt:
Wel in het voorbeeldje maar niet als je de de hele handel een beetje husselt. Het geavanceerde filter zal waarschijnlijk de eerste regel 'onthouden' en de rest verwijderen en weet zeer waarschijnlijk niet dat de rij met de max datum in kolom H 'onthouden' moet worden.

Maar in het het bestandje werkt het dus Foolproof maken kan altijd nog;)
 
Maakt volgens mij niet uit.

De laatste datum van iemand komt bovenaan te staan.
Of kolom C en D door elkaar staan maakt daarbij niet uit.

Remove duplicate laat de eerste regel staan van de array, en dat is de laatste datum.

Ik moet toegeven dat ik het eerst zo had gesorteerd,....

Code:
Sub hsv()
With Sheets("overzicht").Cells(1).CurrentRegion.Resize(, 8)
      .Sort [a1], , [c1], , , [d1], , 1
      .Sort [a1], , [h1], , 2, , , 1
      .RemoveDuplicates Array(1, 3, 4)
 End With
End Sub

....maar heb dat direct weer aangepast.
 
Maakt iid niet uit. Althans het lukt mij niet het stuk te krijgen:d

Daar waar je eerst op gesorteerd had vind ik wel een leuke om eens wat mee te experimenteren. (is weinig over te vinden en komt ook niet vaak voor)
 
Bekijk bijlage Laatste Datum.xlsmAan VenA / HSV / SjonA

Ik heb mijn bestand een beetje aangepast, maar krijg niets meer werkend. Het totaal aantal records ligt nu op 24.000 en loopt nog op.
Ik zou dus de laatste datum ("Kolom i" geworden), alleen willen zien als kolom A,C,D, hetzelfde is ; kolom J is extra informatie die erbij is gekomen.
Ik heb een klein deel van mijn bestand toegevoegd.

Alvast dank voor jullie hulp.
 
Er staat geen code in het bestand. Mogelijk dat het daardoor niet werkt......
 
Code:
Sub hsv()
With Sheets(1).Cells(1).CurrentRegion.Resize(, 10)
      .Sort [i1], 2, , , , , , 1
      .RemoveDuplicates Array(1, 3, 4)
 End With
End Sub
 
Weer eens wat anders:

Code:
Sub M_snb()
    With Blad1.PivotCaches.Create(xlDatabase, "Blad1!R1C1:R152C10").CreatePivotTable("Blad1!R1C14", "snb")
       With .PivotFields("Stock Code")
        .Orientation = xlRowField
        .Position = 1
        End With
        .ColumnGrand = False
        .RowGrand = False
        .AddDataField(.PivotFields("Repair Date"), "Laatste RepDate", xlMax).NumberFormat = "dd-mm-yyyy"
   End With
End Sub
 
Laatst bewerkt:
Heren, bedankt voor jullie input.
Ik heb de code van HSV gebruikt, werkt uitstekend en is snel.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan