Listview Changing Colour Of Duplicate Sub Items - excel

Question

If I have a listview that is populated, how would I go about changing the font colour if the sub item already exists in that column?
Any help would be appreciated.
This is what I have, but it doesn't work correctly
Sub dupeInterpreters(lvw As ListView, iSubItemIndex As Integer)
Dim i As Integer
Dim dupeI As Integer
dupeI = 0
For i = 1 To LVIV.ListItems.Count
If LVIV.ListItems(i).SubItems(iSubItemIndex) = LVIV.ListItems(i).ListSubItems(iSubItemIndex).Text Then 'you could also use the LIKE operator
'LVIV.ListItems(i).Selected = True
LVIV.ListItems(i).Bold = True
LVIV.ListItems(i).ListSubItems(iSubItemIndex).ForeColor = &HC000&
dupeI = dupeI + 1
'Exit For
End If
Next
End Sub
No error, but it highlights every item in the listview, rather than just the duplicate values

Answer 1

Try the following macro, which formats all duplicates...
Sub dupeInterpreters(LVIV As ListView, iSubItemIndex As Integer)
Dim i As Long
Dim j As Long
Dim bDuplicate As Boolean
bDuplicate = False
For i = 1 To LVIV.ListItems.Count - 1
For j = i + 1 To LVIV.ListItems.Count
If LVIV.ListItems(j).SubItems(iSubItemIndex) = LVIV.ListItems(i).ListSubItems(iSubItemIndex).Text Then
'LVIV.ListItems(i).Selected = True
LVIV.ListItems(j).Bold = True
LVIV.ListItems(j).ListSubItems(iSubItemIndex).ForeColor = &HC000&
bDuplicate = True
End If
Next j
If bDuplicate Then
With LVIV.ListItems(i)
.Bold = True
.ListSubItems(iSubItemIndex).ForeColor = &HC000&
End With
bDuplicate = False
End If
Next
Me.Repaint
End Sub
Hope this helps!

Answer 2

Here's another approach. This one uses the Dictionary object to avoid excessive looping, and should be more efficient...
Sub dupeInterpreters(LVIV As ListView, iSubItemIndex As Integer)
Dim dicListSubItemCount As Object
Dim strListSubItem As String
Dim listItemIndex As Long
Set dicListSubItemCount = CreateObject("Scripting.Dictionary")
dicListSubItemCount.comparemode = 1 'case-insensitive comparison
With LVIV
For listItemIndex = 1 To .ListItems.Count
strListSubItem = .ListItems(listItemIndex).ListSubItems(iSubItemIndex).Text
dicListSubItemCount(strListSubItem) = dicListSubItemCount(strListSubItem) + 1
Next listItemIndex
For listItemIndex = 1 To .ListItems.Count
strListSubItem = .ListItems(listItemIndex).ListSubItems(iSubItemIndex).Text
If dicListSubItemCount(strListSubItem) > 1 Then
With .ListItems(listItemIndex)
.Bold = True
.ListSubItems(iSubItemIndex).ForeColor = &HC000&
End With
End If
Next listItemIndex
End With
Me.Repaint
Set dicListSubItemCount = Nothing
End Sub
Hope this helps!