I wrote a macro which sorted my table and deleted the duplicate row like that:
Entitydocnum Docstatus Purchase-order Created-date Eyepeak
======================================================================
test1 pending EL351-EE 27/03/2017 2
test2 pending EL351-EE 06/04/2017 0
test1 pending EL351-EE 30/03/2017 0
test4 pending EL351-EE 25/03/2017 2
As you can see, the ' test1 ' row is duplicated because th Macro thinks it's different because of the date, which is not the same . There is one row 'test1' with 30/03/2017 and the other with 27/03/2017
How can I make my macro ignore the column Created-date (only this column) to merge test1 (27/03/2017) with test1 (30/03/2017).. which take the higher date value.. ?
At this moment my macro is:
(My table start at "B3")
Sub thepcshop_macrotest()
ActiveSheet.Range("B3").Sort _
Key1:=ActiveSheet.Columns("B"), _
Header:=xlGuess
Do While Not IsEmpty(ActiveCell) ' Tant que la cellule active n'est pas vide, recommence
If ActiveCell = ActiveCell.Offset(-1, 0) Then ' Condition : si la cellule active est identique
ActiveCell.EntireRow.Delete ' ˆ la cellule prŽcŽdente (mme colonne), supprime
Else: ActiveCell.Offset(1, 0).Select 'toute la ligne. Sinon, passe ˆ la cellule suivante.
End If
Loop
MsgBox "Done :)"
End Sub
You could sort your data into descending date order and then remove duplicates based on the first three columns.
Sub thepcshop_macrotest()
Dim rData As Range 'Whole data range
Dim rDocNum As Range 'EntityDocNum range
Dim rCreated As Range 'Created-date range
With ThisWorkbook.Worksheets("Sheet1") 'Sheet name will need updating.
'Reference required data ranges - many ways of doing this.
'This method will work if there's nothing else on sheet.
Set rData = .Range(.Cells(Rows.Count, 2).End(xlUp), .Cells(3, Columns.Count).End(xlToLeft))
Set rDocNum = .Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp))
Set rCreated = .Range(.Cells(4, 5), .Cells(Rows.Count, 5).End(xlUp))
'Sort by DocNum ascending and Created date descending.
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rDocNum, _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=rCreated, _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
With .Sort
.SetRange rData
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Remove duplicates based on EntityDocNum, DocStatus and Purchase-order.
rData.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End With
End Sub
Check if this code does what you want.
Sub thepcshop_macrotest()
Dim Tmp As Variant
ActiveSheet.Range("B3").Sort Key1:=ActiveSheet.Columns("B"), _
Header:=xlGuess
Do While Not IsEmpty(ActiveCell) ' Tant que la cellule active n'est pas vide, recommence
With ActiveCell
If .Value = .Offset(-1, 0).Value Then ' Condition : si la cellule active est identique
Tmp = .Offset(0, 3).Formula
If Tmp <> .Offset(-1, 3).Value Then ' i the previous is different
Tmp = Application.Max(Tmp, .Offset(-1, 3).Value)
' replace the previous with the current if it is more recent
If Tmp < .Offset(-1, 3).Value Then .Offset(-1, 3).Value = Tmp
End If
.EntireRow.Delete ' ? la cellule pr?c?dente (mme colonne), supprime
Else
.Offset(1, 0).Select 'toute la ligne. Sinon, passe ? la cellule suivante.
End If
End With
Loop
MsgBox "Done :)"
End Sub
In plain language: if the selected cell has the same value as the one above it, it checks the date in column D. If the date in the current row is more recent the date in the precious row is changed. Whatever the outcome of this test, the current row is deleted if it has the same value in column A as the one above it.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.