Macros code to remove duplicates but keep the last activity entry based on the date.

Occasional Contributor

Hello, 

 

I need some solution to remove duplicates but keep those which were entered with different date.

Currently I am using two macros.

First, to copy data from another workbook and add it to the last row of my current sheet (sheet contains 16 columns):

 

Sub Copy()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim i As Integer
Dim lastrow As Long
Dim verylastrow As Long


If MsgBox("Please make sure you upload Tableau report", vbOKCancel, "Just checking") = vbOK Then

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(FileFilter:="Comma Separated Values Files (*.csv),*.csv")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)
lastrow = ThisWorkbook.Worksheets("sheet1").Range("B9000").End(xlUp).Row + 1
OpenBook.Sheets(1).Range("A2", Range("O2").End(xlDown)).Copy ThisWorkbook.Worksheets("sheet1").Range("A" & lastrow)
OpenBook.Close savechanges:=False

End If

End If

verylastrow = ThisWorkbook.Worksheets("sheet1").Range("B9000").End(xlUp).Row
For i = lastrow To verylastrow
Cells(i, 16).Value = Date

Next

Application.ScreenUpdating = True
'Process_Data2()
End Sub

 

Second, to remove duplicates:

 

Sub Process_Data2()
'
' Process_Data2 Macro
'

'
Range("A1:P2860").Select
Range("E1986").Activate
ActiveSheet.Range("$A$1:$P$1048576").RemoveDuplicates Columns:=Array(1, 2), _

'first column is user ID, second column: some data, third column is last activity with dates (when I include this filter here too many duplicates are not being removed).
Header:=xlYes
End Sub

 

 

5 Replies

@Guram_Bregadze 

Could you make a small sample workbook (without sensitive data) available through OneDrive, Google Drive, Dropbox or similar?

Hello @Hans Vogelaar ,

 

Thank you for your willingness to help!

Monday I will be at work and surely create a sample workbook. 

 

Kind regards,

Guram

It sounds like you have some complex reasoning for when to remove and when not to remove duplicates, like remove all duplicates except if the duplicate is the last entry. Whatever the reasoning, I'd consider adding a helper column to identify through a formula if the entry is eligible for removal, then apply filtering over the first two columns as well as the helper column.

Suggestion: VBA is simpler with tables. It eliminates the xlUp step.
Dim oLo As ListObject
Set oLo = [A1].ListObject
oLo.DataBodyRange.RemoveDuplicates Array(1, 2)

For future consideration: Power Query can accommodate your complex reasoning and produce a filtered table (inside your current workbook or in another workbook) without removing rows from the original table. No VBA required.

In the example below.
"Table1" is the name of the Excel table. Change that name to whatever your table's name is.
"A", "B", "C" are the column heading names, so replace them with your column heading names.
"C" is the helper column. So after we complete filtering, we need to remove it.

let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
RemoveDups = Table.Distinct(Source, {"A","B","C"}),
RemoveCols = Table.RemoveColumns(RemoveDups,{"C"})
in
RemoveCols
Thank you Craig,

I will try.

Kind regards,
Guram
Hello Hans @Hans Vogelaar
The problem occurred to be in something else. I have created the new topic: Copy/Paste VBA script
Sample files attached.
Kind regards,
Guram