Split comma delimited string on comma replace comma with pipe then rejoin Join string

Cells in column H are comma delimited strings. I heed to replace ONLY the comma between the sub-strings

ex:

Social sciences - i.e. human geography, psychology, economics, history, sociology, decision sciences, ecosynomics, Transformations systems - i.e.*theory, processes, structures of large scale systems change

In this case the sub-strings are

Social sciences - i.e. human geography, psychology, economics, history, sociology, decision sciences, ecosynomics

Transformations systems - i.e.*theory, processes, structures of large scale systems change

so I get

Social sciences - i.e. human geography, psychology, economics, history, sociology, decision sciences, ecosynomics|Transformations systems - i.e.*theory, processes, structures of large scale systems change

The code I have gives me

Social sciences - i.e. human geography, psychology, economics, history, sociology, decision sciences, ecosynomics|Transformations systems - i.e.*theory|processes|structures of large scale systems change

Sub FindReplacePipeCol_H()
Dim rng As Range, Dn As Range, n As Long, K As Variant, nStr As String, fd As Boolean

With Sheets("FullOptionLists")
    Set rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
End With


With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In rng
    If InStr(Dn.Value, ", ") Then .Item(Dn.Value) = Empty
Next


With Sheets("RawData")
    Set rng = .Range("H2", .Range("H" & Rows.Count).End(xlUp))
End With


For Each Dn In rng
   fd = False
    For Each K In .Keys
        If .Exists(Left(Dn.Value, Len(K))) And K = Left(Dn.Value, Len(K)) Then
            Dn.Value = K & Replace(Right(Dn.Value, Len(Dn.Value) - Len(K)), ", ", "|")
            fd = True
            Exit For
        End If
    Next K

If Not fd Then Dn.Value = Replace(Dn.Value, ", ", "|")

Next Dn
End With
End Sub

I have been trying for hours get this to no avail

Thanks for any help with this

I have attached a file