5988

Find Duplicate entries when 2 criteria met and mark them

Question:

Is there a way in VBA to find duplicate entries when criteria in 2 columns meet?

I have two columns of data. First column has got dates and the second one amounts. The problem is to find and highlight all amounts that has got a duplicate amount and the same date in corresponding column?

I have so far managed to find a code to highlight duplicates on 1 criteria.

Here is the code

Sub RemoveDuplicateAmounts() Dim cel As Variant Dim myrng As Range Set myrng = Sheets("Sheet1").Range("D2:D" & Sheets("Sheet1").Range("D65536").End(xlUp).Row) myrng.Interior.ColorIndex = xlNone For Each cel In myrng clr = 10 If Application.WorksheetFunction.CountIf(myrng, cel) > 1 Then cel.Interior.ColorIndex = 26 clr = clr + 10 End If Next MsgBox ("All duplicates found and coloured") End Sub

Answer1:

This is a VBA attempt at the same thing I have given formula to. I don't think it was necessary but OP might learn from it anyways. Cheers!

Sub ertdfgcvb() Dim LastRow As Long, DatesCol As Long, AmountsCol As Long, a As Double, b As Double LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row DatesCol = 4 'D column with dates AmountsCol = 5 'E column with amounts Columns(DatesCol).Interior.ColorIndex = xlNone 'dates lose color For i = 1 To LastRow 'for each row If i <> 1 Then 'had some fun with row 0 error a = Application.WorksheetFunction.SumIfs( _ Range(Cells(1, DatesCol), Cells(i - 1, DatesCol)), _ Range(Cells(1, DatesCol), Cells(i - 1, DatesCol)), _ Cells(i, DatesCol), _ Range(Cells(1, AmountsCol), Cells(i - 1, AmountsCol)), _ Cells(i, AmountsCol)) 'counts the date values associated with recurrences before Else a = 0 'if it's first row I declared a zero, I don't know why End If If i <> LastRow Then 'yeah, last row stuff b = Application.WorksheetFunction.SumIfs( _ Range(Cells(i + 1, DatesCol), Cells(LastRow, DatesCol)), _ Range(Cells(i + 1, DatesCol), Cells(LastRow, DatesCol)), _ Cells(i, DatesCol), _ Range(Cells(i + 1, AmountsCol), Cells(LastRow, AmountsCol)), _ Cells(i, AmountsCol)) 'counts the date values associated with recurrences after Else b = 0 'if it's the last row, there are definitely none after End If If a <> 0 Or b <> 0 Then Cells(i, 4).Interior.ColorIndex = 26 'if either one of them isn't 0 then the date value gets a nice background color Next i End Sub

With a Countifs and some optimisation it will look like this:

Sub ertdfgcvb() Dim LastRow As Long, DatesCol As Long, AmountsCol As Long LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row DatesCol = 4 'D column with dates AmountsCol = 5 'E column with amounts Columns(DatesCol).Interior.ColorIndex = xlNone 'dates lose color For i = 1 To LastRow 'for each row If 1 < Application.WorksheetFunction.CountIfs(Range(Cells(1, DatesCol), Cells(LastRow, DatesCol)), _ Cells(i, DatesCol), _ Range(Cells(1, AmountsCol), Cells(LastRow, AmountsCol)), _ Cells(i, AmountsCol)) _ Then Cells(i, 4).Interior.ColorIndex = 26 ' 'counts the date values associated with occurrences if there's more than one then the date gets a nice background color Next i End Sub

Answer2:

=SUMIFS($D$1:$D1,$D$1:$D1,$D2,$E$1:$E1,$E2)+SUMIFS($D3:$D$1048576,$D3:$D$1048576,$D2,$E3:$E$1048576,$E2)

And for working with VBA:

=SUMIFS(R1C4:R[-1]C4,R1C4:R[-1]C4,RC4,R1C5:R[-1]C5,RC5)+SUMIFS(R[1]C4:R1048576C4,R[1]C4:R1048576C4,RC4,R[1]C5:R1048576C5,RC5)

These sum <strong>D</strong> (assumed to be dates) based on <strong>D</strong> (dates) and <strong>E</strong> (amounts) both before and after given row. Change the <em>C5</em> and <em>C4</em> where needed to fit your dataset.

To get to the true/false statements I'd say just put a 0<> before:

=0<>SUMIFS(R1C4:R[-1]C4,R1C4:R[-1]C4,RC4,R1C5:R[-1]C5,RC5)+SUMIFS(R[1]C4:R1048576C4,R[1]C4:R1048576C4,RC4,R[1]C5:R1048576C5,RC5)

Recommend

  • Excel Return Multiple Unique Values
  • Count if for excel VBA, and printing results in another range
  • VBA Application Defined Error
  • Extracting the two smallest values corresponding to the unique-to-the-column ID
  • Copy/Paste remove duplicates/blanks: Array Column
  • Vlookup in VBA within a for loop
  • Convert raster images to vector graphics using OpenCV?
  • Excel VBA-Duplicates run with button/add location
  • drawing ellipses/hyperbolas in R
  • VBA: How can I keep only the date values from a string?
  • Why are Google search results in UIWebView not triggering webViewDidFinishLoad?
  • Variable between worksheet and module not cooperating
  • vba paste values and keep source formatting?
  • Erase empty cells in an array
  • Delete All Rows With Errors in a column
  • How do I pass worksheet and ranges as variables?
  • How to Translate texts contained in MsgBox in Inno Setup?
  • Can a variable be stored within an image or div tag?
  • VB.Net Double comparison after some additions
  • WPF Template Binding in ToggleButton UserControl
  • Cast between interfaces whose interface signatures are same
  • C# - Serializing and deserializing static member
  • Volusion's generic SQL folder, functionality
  • How to set/get protobuf's extension field in Go?
  • Sending data from AppleScript to FileMaker records
  • JSON with duplicate key names losing information when parsed
  • Can I have the cursor start on a particular column by default in jqgrid's edit mode?
  • Statically linking a C++ library to a C# process using CLI or any other way
  • VBA Convert delimiter text file to Excel
  • Rearranging Cells in UITableView Bug & Saving Changes
  • Circular dependency while pushing http interceptor
  • Linker errors when using intrinsic function via function pointer
  • How to include full .NET prerequisite for Wix Burn installer
  • FormattedException instead of throw new Exception(string.Format(…)) in .NET
  • python draw pie shapes with colour filled
  • Is it possible to post an object from jquery to bottle.py?
  • Observable and ngFor in Angular 2
  • How to Embed XSL into XML
  • UserPrincipal.Current returns apppool on IIS
  • Conditional In-Line CSS for IE and Others?