Excel VBA: How to get COUNTIF function to not pick up text cells "1.1" and "1.10" as Duplicates?

Question

I am using the CountiF Function in Excel VBA to check for duplicates for an array of ID numbers that are as follows:

• 1.0
• 1.1
• 1.2
• 1.3
• 1.4
• 1.5
• 1.6
• 1.7
• 1.8
• 1.9
• 1.10
• 1.11
• ...

With the code that i am using, "1.1" and "1.10", both formatted as text cells, are showing up as duplicates when i dont want them to.

The following is my code and i would like to know what tweak if possible could resolve this issue?

Thank you.

    'RESET ERROR IN HISTORY
        Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "No Duplicates"
    
    'SET STARTING CELL
        Cells(1, 3).Select
    
    'GET ACTIVE COLUMN
        Dim Col As Long
        Col = ActiveCell.Column
        
    'ESTABLISH END ROW
        Call Get_Last_Row
        Dim EndRow As Long
        EndRow = ActiveCell.Row
        Cells(1, Col).Select
        
    'RUN MAIN LOOP
        Dim Cell As Variant
        Dim Source As Range
        Set Source = Range(Cells(1, Col), Cells(EndRow, Col))

        For Each Cell In Source
        
            If Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then
                Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "Duplicates"
                Cell.Interior.ThemeColor = xlThemeColorAccent5
            End If
        
        Next
        
        If Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = "Duplicates" Then
            MsgBox "Duplicate Sheet Names Found"
        End If

question from:https://stackoverflow.com/questions/65876185/excel-vba-how-to-get-countif-function-to-not-pick-up-text-cells-1-1-and-1-10

Answer 1

Instead of Countif() you can use Worksheet.Evaluate to run an array formula which will not count the cells as though they're numbers:

Dim dupes As Long, c As Range, ws As Worksheet, col As Long, rng As Range, n

Set ws = ActiveSheet 'or whatever

col = ActiveCell.Column
Set rng = ws.Range(ws.Cells(1, col), ws.Cells(Rows.Count, col).End(xlUp))
    
For Each c In rng.Cells
    'this will not count values as numbers...
    n = ws.Evaluate("=SUM(1*(" & rng.Address & "=" & c.Address & "))")
    If n > 1 Then
        dupes = dupes + 1
        c.Interior.ThemeColor = xlThemeColorAccent5
    Else
        c.Interior.ColorIndex = xlNone
    End If
Next
    
Workbooks("PERSONAL.xlsb").Sheets("History").Range("F2").Value = _
               IIf(dupes > 0, "Duplicates", "No Duplicates")
               
If dupes > 0 Then MsgBox "Duplicate Sheet Names Found"