VBA for duplicate rows - excel

Question

I have a sheet of columns.
I want to compare data in multiple columns, and return a flag in another column to indicate rows that are duplicates. I found a little code online which was meant for checking one column of data, and have so far been unsuccessful in being able to tweek it for multiple columns. The final code will need to look at specific columns which I will define later however for the moment say the sheet is as follows:
StaffNumber CallType
1 A
2 B
1 A
4 D
5 E
6 F
7 G
8 H
1 A
2 C
1 Z
6 P
The Col A is labelled Staff Number. Col B is labelled CallType. In Col C I want the flag to be entered against the row.
My Code is as follows:
Sub DuplicateIssue()
Dim last_StaffNumber As Long
Dim last_CallType As Long
Dim match_StaffNumber As Long
Dim match_CallType As Long
Dim StaffNumber As Long
Dim CallType As Long
last_StaffNumber = Range("A65000").End(xlUp).Row
last_CallType = Range("B65000").End(xlUp).Row
For StaffNumber = 1 To last_StaffNumber
For CallType = 1 To last_CallType
'checking if the Staff Number cell is having any item, skipping if it is blank.
If Cells(StaffNumber, 1) <> " " Then
'getting match index number for the value of the cell
match_StaffNumber = WorksheetFunction.Match(Cells(StaffNumber, 1), Range("A1:A" & last_StaffNumber), 0)
If Cells(CallType, 2) <> " " Then
match_CallType = WorksheetFunction.Match(Cells(CallType, 2), Range("B1:B" & last_CallType), 0)
'if the match index is not equals to current row number, then it is a duplicate value
If StaffNumber <> match_StaffNumber And CallType <> match_CallType Then
'Printing the label in the column C
Cells(StaffNumber, 3) = "Duplicate"
End If
End If
End If
Next
Next
End Sub
My problem is that only when Col 1 is a duplicate will the macro enter "Duplicate" into Col C, and it is not checking if the value of Col B is also the same.
Any Help would be much appreciated.

Answer 1

Try this code:
.
Option Explicit
Public Sub showDuplicateRows()
Const SHEET_NAME As String = "Sheet1"
Const LAST_COL As Long = 3 ' <<<<<<<<<<<<<<<<<< Update last column
Const FIRST_ROW As Long = 2
Const FIRST_COL As Long = 1
Const DUPE As String = "Duplicate"
Const CASE_SENSITIVE As Byte = 1 'Matches UPPER & lower
Dim includedColumns As Object
Set includedColumns = CreateObject("Scripting.Dictionary")
With includedColumns
.Add 1, "" ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 1 as dupe criteria
.Add 3, "" ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< col 3 as dupe criteria
End With
Dim searchRng As Range
Dim memArr As Variant
Dim i As Long
Dim j As Long
Dim unique As String
Dim totalRows As Long
Dim totalCols As Long
Dim totalURCols As Long
Dim valDict As Object
Set valDict = CreateObject("Scripting.Dictionary")
If CASE_SENSITIVE = 1 Then
valDict.CompareMode = vbBinaryCompare
Else
valDict.CompareMode = vbTextCompare
End If
With ThisWorkbook.Sheets(SHEET_NAME)
totalRows = .UsedRange.Rows.Count 'get last used row on sheet
totalURCols = .UsedRange.Columns.Count 'get last used col on sheet
Set searchRng = .Range( _
.Cells(FIRST_ROW, FIRST_COL), _
.Cells(totalRows, LAST_COL) _
)
If LAST_COL < totalURCols Then
.Range( _
.Cells(FIRST_ROW, LAST_COL + 1), _
.Cells(FIRST_ROW, totalURCols) _
).EntireColumn.Delete 'delete any extra columns
End If
End With
memArr = searchRng.Resize(totalRows, LAST_COL + 1) 'entire range with data to mem
For i = 1 To totalRows 'each row, without the header
For j = 1 To LAST_COL 'each col
If includedColumns.exists(j) Then
unique = unique & searchRng(i, j) 'concatenate values on same row
End If
Next
If valDict.exists(unique) Then 'check if entire row exists
memArr(i, LAST_COL + 1) = DUPE 'if it does, flag it in last col
Else
valDict.Add Key:=unique, Item:=i 'else add it to the dictionary
End If
unique = vbNullString
Next
searchRng.Resize(totalRows, LAST_COL + 1) = memArr 'entire memory back to the sheet
End Sub
.
Result: