Helps VBA code add "-new" to names that appear 3 times or more

[Excelpromax123]

Hello Everyone. I need a piece of VBA code to filter out as described in the image below. Thank you very much!

test 3.xlsm

drive.google.com

 

[SunnyAlv]

It's pretty bad but it works

Sub Macro1()

Dim l As Long

l = Range("A" & Rows.Count).End(xlUp).Row
With Range("C2:C" & l)
    .Value = "=IF(COUNTIF(A2:$A$2,A2)>3,A2&""-New"",A2)"
    .Copy
    .PasteSpecial xlPasteValues
End With

Application.CutCopyMode = False
End Sub

 

[kvsrinivasamurthy]

Try. Column C is result range.

Sub Add_New()
Dim A, T&, Rpt&

A = Range("A1").CurrentRegion.Offset(1, 0)
ReDim B(1 To UBound(A, 1), 1 To 1)
Rpt = 1: B(1, 1) = A(1, 1)
With CreateObject("Scripting.dictionary")
For T = 1 To UBound(A, 1) - 1
If .exists(A(T, 1)) Then .Item(A(T, 1)) = .Item(A(T, 1)) + 1 Else .Item(A(T, 1)) = 1
If .Item(A(T, 1)) <= 3 Then B(T, 1) = A(T, 1) Else B(T, 1) = A(T, 1) & "-New"
Next T
Range("C1") = "Output"
Range("C2").Resize(UBound(A, 1) - 1, 1) = B
End With
End Sub