Removing Duplicate Legend Entries using VBA

Question

This code is to remove repeat legend entries. It will work as long as there isn't any series on the 2nd Y axis. As then the Series collection order and the LegendEntries order are different. I would like it to work with series on the 2nd Y axis too.

Is there a more efficient way of doing by just using the LegendEntries only?

Sub legend_tartup()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim Cht As Chart
Dim CurrentSheet As Worksheet
Dim lgnd As Legend
Dim uniqueEntries As New Collection
Dim LgdID As New Collection
Dim No2ndAxis As Integer
Dim i As Long
Dim Series_Count As Integer
Dim LeftPos As Integer
Dim TopPos As Integer


  Application.ScreenUpdating = False
  Application.EnableEvents = False

For Each Cht In ActiveWorkbook.Charts

    No2ndAxis = 0
    
    If Cht.HasLegend = True Then
        LeftPos = Cht.Legend.Left
        TopPos = Cht.Legend.Top
    Else
        LeftPos = Empty
        TopPos = Empty
    End If
    
    Cht.HasLegend = False
    
    ' Add a new legend with desired settings
    Cht.HasLegend = True
    Set lgnd = Cht.Legend
    With lgnd
        .IncludeInLayout = False
        .Border.LineStyle = xlContinuous
        .Border.ColorIndex = 1  ' Black
        .Interior.ColorIndex = 2  ' White
        If LeftPos = Empty Then
            .Position = xlLegendPositionCorner
        Else
            .Left = LeftPos
            .Top = TopPos
        End If
    End With
    

    Series_Count = Cht.SeriesCollection.Count
    

'Find uniquie legends and there order number
    For i = 1 To Series_Count
    'Debug.Print Cht.SeriesCollection(i).Name
    'Debug.Print lgnd.LegendEntries(i).Parent
        If CollectionValueExists(uniqueEntries, Cht.SeriesCollection(i).Name) = False Then
            uniqueEntries.Add Cht.SeriesCollection(i).Name
            LgdID.Add i
        End If
    Next i
' delete legends that are repeated
    For i = Series_Count To 1 Step -1
        If CollectionValueExists(LgdID, i) = False Then
            lgnd.LegendEntries(i).Delete
        End If
    Next i
    
    
Set uniqueEntries = Nothing
Set LgdID = Nothing

Next Cht

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

....

Public Function CollectionValueExists(ByRef target As Collection, value As Variant) As Boolean
        Dim index As Long
        For index = 1 To target.Count
            If target(index) = value Then
                CollectionValueExists = True
                Exit For
            End If
        Next index
    End Function