Adding a data validation list where entries have commas

I am using this code to add a defined list to a cell. The range of entries which I wish to populate this list have commas within their names. The code then recognises this line as two or more items within the TempList string. Is there a way to include the comma within the items and not have it split out?

Sub DefinedPartnerListPop()

   Dim rList As String
   Dim MyCol As Collection
   Dim i, n, k, j, a As Integer
   Dim TempList, Partner As String
   Dim WSHT, WSHT2 As Worksheet
   Dim Swap1, Swap2



   Set WSHT = Sheet1

   With WSHT
   a = WorksheetFunction.CountA("A1:A13")
   k = WorksheetFunction.CountA(.Range("A:A")) - a


 Set MyCol = New Collection
        For i = 1 To k
        If Len(Trim(.Range("B" & 13 + i).Value)) <> 0 And .Range("A" & 13 + i) <> "" Then
            On Error Resume Next
          Partner = .Range("B" & 13 + i).Text
            MyCol.Add Partner
            On Error GoTo 0
        End If
    Next i




    For n = 1 To MyCol.Count
        TempList = TempList & "," & MyCol(n)
    Next

    TempList = Mid(TempList, 2)


End With
With WSHT

.Range("B12").ClearContents: .Range("B12").Validation.Delete
With .Range("B12")
 With .Validation
'Call UnProtectChecklistSht
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=TempList
    .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True

End With
End With
End With



End Sub