Not able to get Highlight & Count VBA working - vba

Question

I found a macro to count & Highlight Duplicates. My friend & I have tried to get it working, but have not been able to get it working. Column A ( Name), Column L ( Yes - Filter), Column M (Duplicate). In addition to getting the code working, we are trying to get the macro to filter on Yes in column L, and Print Duplicate in Column M. Please advise what is wrong & how to fix the problem. Here is the code:
Option Explicit
Sub Find_Duplicates()
Dim col As Integer
Dim rng As String
col = 3
rng = "A5:A"
HighLightDuplicates rng, col
ShowMaxOnly rng, col
End Sub
Sub HighLightDuplicates(ByVal rng As String, ByVal col As Integer)
Dim i, j As Integer
Dim temp As Variant
Range(rng).Select
Dim Count As Integer
Count = 1
For i = 1 To Selection.Count
temp = Range(Left(rng, 1) & i)
For j = i + 1 To Selection.Count
If temp = Range(Left(rng, 1) & j) And temp <> "" Then
Count = Count + 1 'increase the number of duplicates
'highlight the duplicates
Range(Left(rng, 1) & i).Interior.Color = RGB(0, 100, 255)
Range(Left(rng, 1) & j).Interior.Color = RGB(0, 100, 255)
End If
Next
'show the number of duplicates
If Count > 1 Then
Cells(i, col) = Count & " duplicates"
End If
'reset count
Count = 1
Next
End Sub
'show only the biggest number of duplicates in a group
Sub ShowMaxOnly(ByVal rng As String, ByVal col As Integer)
Dim i, j As Integer
Dim temp As Variant
Range(rng).Select
i = 1
For i = 1 To Selection.Count
temp = Range(Left(rng, 1) & i)
For j = i + 1 To Selection.Count
If temp = Range(Left(rng, 1) & j) And temp <> "" Then
Cells(j, col) = "" 'remove the smaller numbers duplicates
End If
Next
Next
End Sub

Answer 1

Maybe this would work for you.
It adds the formula and then uses conditional formatting to highlight the cells.
Public Sub Find_Duplicates()
Dim wrkSht As Worksheet 'The worksheet that you're lookin for duplicates in.
Dim rng As Range 'The range containing the duplicates.
Dim Col As Long 'The last column containing data +1
Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
With wrkSht
'Reference to whole data range.
Set rng = .Range("A5:L25")
'If the sheet is blank an error will be thrown when trying to find the last column.
'This code looks for the last column - you could just set Col to equal the last column number + 1.
On Error Resume Next
Col = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Err.Clear
On Error GoTo 0
If Col = 0 Then Col = 1
'Place a COUNTIF formula in the last column.
rng.Offset(, Col).Columns(1).FormulaR1C1 = "=COUNTIF(" & rng.Columns(1).Address(ReferenceStyle:=xlR1C1) & ",RC" & rng.Column & ") & "" duplicates."""
With rng
'Add conditional formatting to first column in range: If the COUNTIF formula is showing >1 then highlight cell.
With .Columns(1)
'This formula is =VALUE(LEFT($M5,FIND(" ",$M5)-1))>1.
'It returns only the number from the duplicate count and checks it is higher than 1.
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=VALUE(LEFT(" & rng.Offset(, Col).Cells(1).Address(RowAbsolute:=False) & ",FIND("" ""," & _
rng.Offset(, Col).Cells(1).Address(RowAbsolute:=False) & ")-1))>1"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Interior.Color = RGB(0, 100, 255)
End With
'Apply filter to your range.
.AutoFilter
.AutoFilter Field:=12, Criteria1:="Yes"
End With
End With
End Sub
Updated code:
This will always place the last column as 1 to the right of the range set in the variable rng.
Public Sub Find_Duplicates()
Dim wrkSht As Worksheet 'The worksheet that you're lookin for duplicates in.
Dim rng As Range 'The range containing the duplicates.
Dim rLastCol '1 column to right of rng.
Dim Col As Long 'The last column containing data +1
Set wrkSht = ThisWorkbook.Worksheets("Sheet1")
With wrkSht
'Reference to whole data range.
Set rng = .Range("A5:L25")
Set rLastCol = rng.Offset(, 1).Columns(rng.Columns.Count)
'Place a COUNTIF formula in the last column.
rLastCol.FormulaR1C1 = "=COUNTIF(" & rng.Columns(1).Address(ReferenceStyle:=xlR1C1) & ",RC" & rng.Column & ") & "" duplicates."""
With rng
'Add conditional formatting to first column in range: If the COUNTIF formula is showing >1 then highlight cell.
With .Columns(1)
'This formula is =VALUE(LEFT($M5,FIND(" ",$M5)-1))>1.
'It returns only the number from the duplicate count and checks it is higher than 1.
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=VALUE(LEFT(" & rLastCol.Cells(1).Address(RowAbsolute:=False) & ",FIND("" ""," & _
rLastCol.Cells(1).Address(RowAbsolute:=False) & ")-1))>1"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(.FormatConditions.Count).Interior.Color = RGB(0, 100, 255)
End With
End With
End With
End Sub