PDA

View Full Version : Colour duplicated text strings



mprija
10-25-2006, 01:35 AM
I have big spreadsheets where in A column are 3 letter codes (JFK), in some cases they stand alone in one cell and in other cases there can be more of them in cell separated by / (JFK/LGA/HOU,....). Problem is that some codes are duplicated. I need a macro which would be able to check column A for codes which are duplicated and colour them. I have attached example file, so that is easyier to understand how my data looks and what I would like that macro will do for me. For any help I would be grateful.

Bob Phillips
10-25-2006, 02:01 AM
Sub MarkDuplicates()
Const sFormula = "=SUMPRODUCT(--(ISNUMBER(FIND("""
Dim iLastRow As Long
Dim ary
Dim i As Long, j As Long
Dim iPos As Long

With ActiveSheet
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To iLastRow
ary = Split(.Cells(i, "A").Value, "/")
For j = LBound(ary) To UBound(ary)
If .Evaluate(sFormula & ary(j) & """,A2:A" & iLastRow & "))))") > 1 Then
iPos = InStr(.Cells(i, "A").Value, ary(j))
.Cells(i, "A").Characters(iPos, Len(ary(j))).Font.ColorIndex = 3
End If
Next j
Next i
End With

End Sub

Bob Phillips
10-25-2006, 02:31 AM
Cross-posted at OzGrid, http://www.ozgrid.com/forum/showthread.php?t=59150.

mprija, please read http://www.excelguru.ca/node/7

mprija
10-25-2006, 02:53 AM
XLD big thank to you for fast reply and sorry for cross posting, I am still green in forums posts, I did not want to upset anybody, so sorry me please. I just have one more question, how to change your code so that instead for looking for duplicates in Column A it would shearch for them in first row?

Bob Phillips
10-25-2006, 07:05 AM
Sub MarkDuplicates()
Const sFormula = "=SUMPRODUCT(--(ISNUMBER(FIND("""
Dim iLastCol As Long
Dim ary
Dim i As Long, j As Long
Dim iPos As Long

With ActiveSheet
iLastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = 1 To iLastCol
ary = Split(.Cells(1, i).Value, "/")
For j = LBound(ary) To UBound(ary)
If .Evaluate(sFormula & ary(j) & """,1:1))))") > 1 Then
iPos = InStr(.Cells(1, i).Value, ary(j))
.Cells(1, i).Characters(iPos, Len(ary(j))).Font.ColorIndex = 3
End If
Next j
Next i
End With

End Sub