CheckExcelDuplicates
From scripting
Function CheckExcelDuplicates(ColumnNo As Integer, EndRow As Integer, CheckEmptyStrings As Boolean) As Boolean Dim ColStrArr() ReDim ColStrArr(0) For X = 1 To EndRow Dim XCounter As Integer XCounter = 0 Dim CurCellStr As String CurCellStr = CStr(CurCells(X, ColumnNo).Value) While XCounter < UBound(ColStrArr) If ColStrArr(XCounter) = CurCellStr Then CheckExcelDuplicates = True CurCells(X, ColumnNo).Font.colorindex = 41 Exit Function End If XCounter = XCounter + 1 Wend If CheckEmptyStrings = False And CurCellStr = "" Then Else ColStrArr(UBound(ColStrArr)) = CurCellStr ReDim Preserve ColStrArr(UBound(ColStrArr) + 1) End If Next X End Function