PDA

View Full Version : Macro to check 4 columns to check for Unique combination & highlight dups



chakkrav
04-08-2017, 02:36 PM
Hi,

I have multiple sheets, where in each sheet i need to check 4 non contiguous columns (different in sheet) for unique combination. After concatenating the 4 cols, If its not unique i.e. if it is duplicate highlight them as & throw a message saying the respective 4 columns values are not unique.

Attached is the sample file, which i'm currently manually doing a concatenation of the 4 cols & checking for duplicate records through conditional formatting.
Need help with a macro to perform the same in the background and throw a message to my users.
Highly appreciate if somebody has an solution to this issue.

mdmackillop
04-09-2017, 05:27 AM
Sub test() Dim arrA(), arrB(), rng, i, rws
Set rng = Cells(1, 2).CurrentRegion
rws = rng.Rows.Count
ReDim arrA(1 To rws)
ReDim arrB(1 To rws)

For i = 1 To rng.Rows.Count
arrA(i) = rng(i, 1) & rng(i, 3) & rng(i, 5) & rng(i, 7)
Next
arrB = arrA
For i = 1 To rng.Rows.Count
For j = 1 To rng.Rows.Count
If arrA(j) = arrB(i) And i <> j Then
rslt = rslt & i & ", "
End If
Next j
Next
MsgBox rslt
End Sub

p45cal
04-09-2017, 10:47 AM
You can use conditional formatting to highlight duplicate rows. See attached which includes the following code which works on the active sheet:
Sub blah()
Set Rng = Intersect(Cells(1, 2).CurrentRegion, Range("B:K"))
Set Rng = Intersect(Rng, Rng.Offset(1))
With Rng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=SUMPRODUCT(--(" & Rng.Columns(1).Address & " & " & Rng.Columns(3).Address & " & " & Rng.Columns(5).Address & " & " & Rng.Columns(7).Address & " = " & Rng.Cells(1, 1).Address(0, 1) & " & " & Rng.Cells(1, 3).Address(0, 1) & " & " & Rng.Cells(1, 5).Address(0, 1) & " & " & Rng.Cells(1, 7).Address(0, 1) & "))>1"
.FormatConditions(1).Interior.Color = 9359529
End With
End SubThe attached has a couple of buttons to click.