excel_replace_user_names.vba

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim cell As Range
    Dim table As ListObject
    Dim column As Integer
    Dim emailDict As Object
    Dim email As String
    
    Set table = Me.ListObjects("Table1")
    column = table.ListColumns("User").Index
    
    ' Create dictionary of email replacements
    Set emailDict = CreateObject("Scripting.Dictionary")
    emailDict.Add "first.last@domain.net", "Last, First"
    emailDict.Add "john.doe@domain.net", "Doe, John"
    ' Add additional email replacements as needed
    
    For Each cell In Target.Cells
        If Not Intersect(cell, table.DataBodyRange) Is Nothing Then
            If cell.Column = column Then
                email = cell.Value
                If emailDict.Exists(email) Then
                    cell.Value = emailDict(email)
                End If
            End If
        End If
    Next cell
End Sub

This script will automatically find email addresses in Table1 column User and replace it with custom text pulled from a dictionary called emailDict. This is very specific to me because I pull a report with usernames as email addresses that I want to be lastname, firstname instead.