Prefix & Suffix komma gescheiden waardes

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim rng As Range        'Main
    Dim aCell As Range      'Main
    
    On Error GoTo Whoa
    Application.EnableEvents = False
    
'ExtAccessLevelIDList                                                   !!!!!!!!!!!!!!!!!CHECK NEEDED!!!!!!!!!!!!!!!!
   [B] Set rng = Range("A2:A5000")
    If Not Application.Intersect(Target, rng) Is Nothing Then
            For Each aCell In rng
                If Not aCell.Value Like "{*}" And aCell.Value <> "" Then
                        aCell = "{" & aCell.Value & "}"[/B]
                     End If
                 Next
            End If


'Letscontinue
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Set rng = Nothing
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Application.Intersect(Target, Range("A2:A5000")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If left(Target.Value, 1) <> "{" And InStr(1, Target.Value, ",") > 1 Then
        Target.Value = "{" & Target.Value & "}"
    End If
    Application.EnableEvents = True
End Sub