Copy Adjacent cell if a cell value equal any cell value in the range

Question

I'm working on a range of columns from G:N to register cleints names and phone number adjacent to the name as show in the flowing MD

The client name maybe repeated more than one time in the range and what I need to do is to have a vba code to copy the phone number of the client to the next adjacent cell if the name was repeated before at any one of the four name columns ("G-I-K-M").....

Unfortunately I couldn't solve it with xlookup or else formula because in case if there is no match in the range then I have to insert the phone number manually and this overrides the formula in the cell and stop it to expand in the new row and I have to copy the formula again every time to the new cell

looking for your professional help please.

Answer 1

• Right-click on the sheet tab, select View Code and paste the code into the code window

Microsoft documentation:

Application.Intersect method (Excel)

Application.Union method (Excel)

Worksheet.Change event (Excel)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const START_ROW = 5
    Const COL_NAME_FIRST = 7 ' Col G
    Const CNT_NAME = 4
    With Target
        If .CountLarge > 1 Or .Row < START_ROW Or Len(.Cells(1).Value) = 0 Then Exit Sub
        Dim rngName As Range, i As Long, rngCol As Range
        Set rngName = Me.Columns(COL_NAME_FIRST)
        For i = 1 To CNT_NAME - 1
            Set rngName = Union(rngName, Me.Columns(COL_NAME_FIRST).Offset(, i * 2))
        Next
        If Application.Intersect(Target, rngName) Is Nothing Then Exit Sub
        Set rngName = Intersect(rngName, Me.UsedRange)
        For Each rngCol In rngName.Columns
            Dim vRes: vRes = Application.Match(.Value, rngCol, 0)
            If Not IsError(vRes) Then
                Application.EnableEvents = False
                .Offset(, 1) = rngCol.Offset(, 1).Cells(vRes)
                Application.EnableEvents = True
                Exit Sub
            End If
        Next
    End With
End Sub