Option Explicit
Sub Test()
Dim rngData As Excel.Range
Dim rngCell As Excel.Range
Dim strFormula As String
Set rngData = Range("A7").CurrentRegion
If rngData.Rows.Count = 1 Then Exit Sub
Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
With rngData.Columns(rngData.Columns.Count).Offset(0, 1)
strFormula = "=CONCAT("
For Each rngCell In rngData.Rows(1).Cells
strFormula = strFormula & rngCell.Address(False, False, xlR1C1, RelativeTo:=.Cells(1)) & ",""|"","
Next
Mid$(strFormula, Len(strFormula)) = ")"
.Offset(0, 0).FormulaR1C1 = strFormula
.Offset(0, 1).FormulaR1C1 = "=COUNTIF(" & .Address(True, True, xlR1C1) & ",RC[-1])"
.Offset(0, 2).FormulaR1C1 = "=MATCH(RC[-2]," & .Address(True, True, xlR1C1) & ",0)"
.Offset(0, -1).Resize(, 2).Value = .Offset(0, 1).Resize(, 2).Value
.Offset(0, 1).Resize(, 2).ClearContents
With rngData.Resize(, rngData.Columns.Count + 1)
Call .RemoveDuplicates(.Columns.Count)
End With
.ClearContents
End With
End Sub