KeyValue Highlighting Issue

Public Sub validateList(ByVal ListRange As Range)
Dim List As Dictionary
Dim Problem As Dictionary
Dim Items() As String
Dim Pairs() As String
Dim Item As Variant
Dim Pair As Variant
Dim Output As String
Dim Position As Integer

    Set List = New Dictionary
    Set Problem = New Dictionary

    Items = Split(ListRange.Value, Main.LST_SEPERATOR)

    Invalid = ""

    For Each Item In Items
        Item = Trim(Item)
        Pairs = Split(Item, Main.QTY_SEPERATOR)
        For Each Pair In Pairs
            Pair = Trim(Pair)
        Next Pair
        Select Case UBound(Pairs)
        Case 1
            ' Part and Quantity
            If CStr(Main.parseInteger(Pairs(0))) = Pairs(0) Then
                ' Pairs(0) Probably Quantity
                If CStr(Main.parseInteger(Pairs(1))) = Pairs(1) Then
                    ' Problem! Both Pairs(0) and Pairs(1) are Numbers
                    Problem.Add Pairs(0) & Main.QTY_SEPERATOR & Pairs(1), 0
                Else
                    ' Pairs(0) = Quantity, Pairs(1) = Part
                    If List.Exists(Pairs(1)) = False Then
                        List.Add Pairs(1), Main.parseInteger(Pairs(0))
                    Else
                        List(Pairs(1)) = List(Pairs(1)) + Main.parseInteger(Pairs(0))
                    End If
                End If
            Else
                ' Pairs(0) Probably Part
                If CStr(Main.parseInteger(Pairs(1))) = Pairs(1) Then
                    ' Pairs(0) = Part, Pairs(1) = Quantity
                    If List.Exists(Pairs(0)) = False Then
                        List.Add Pairs(0), Main.parseInteger(Pairs(1))
                    Else
                        List(Pairs(0)) = List(Pairs(0)) + Main.parseInteger(Pairs(1))
                    End If
                Else
                    ' Problem! Both Pairs(0) and Pairs(1) are Strings
                    Problem.Add Pairs(0) & Main.QTY_SEPERATOR & Pairs(1), 0
                End If
            End If
        Case 0
            ' Part Only
            If List.Exists(Pairs(0)) = False Then
                List.Add Pairs(0), 1
            Else
                List(Pairs(0)) = List(Pairs(0)) + 1
            End If
        Case Else
            Problem.Add Item, 0
        End Select
    Next Item

    Position = 1

    ListRange.Value = ""

    For Each Item In Problem.Keys
        If Not ListRange.Value = "" Then
            ListRange.Value = ListRange.Value & ", "
            Debug.Print Position
            With ListRange.Characters(Start:=Position, Length:=2)
                .Font.Color = RGB(0, 0, 0)
                .Font.Bold = False
            End With
            Position = Position + 2
        End If

        Output = Item

        ListRange.Value = ListRange.Value & Output
        With ListRange.Characters(Start:=Position, Length:=Len(Item))
            .Font.Color = RGB(255, 0, 0)
            .Font.Bold = True
        End With
        Position = Position + Len(Item)
    Next Item

    For Each Item In List.Keys
        If Not ListRange.Value = "" Then
            ListRange.Value = ListRange.Value & ", "
            With ListRange.Characters(Start:=Position, Length:=2)
                .Font.Color = RGB(0, 0, 0)
                .Font.Bold = False
            End With
            Position = Position + 2
        End If

        If List(Item) = 1 Then
            Output = Item
        Else
            Output = Item & Main.QTY_SEPERATOR & List(Item)
        End If

        ListRange.Value = ListRange.Value & Output
        With ListRange.Characters(Start:=Position, Length:=Len(Output))
            .Font.Color = RGB(0, 0, 0)
            .Font.Bold = False
        End With
        Position = Position + Len(Item)
    Next Item

End Sub