vba duplicate and partial string match - vba

Question

I have a list of product codes where I want to mark it ** at the end of the code if there is different location.
To elaborate that, an example of the product code is PFL512241-02 where 02 is the location code. So if I get PFL512241-02 and PFL512241-03 in the list, I would like mark my result as PFL512241-02**; so smaller number of my location. If PFL512241-02 shows up 5 times, result should be PFL512241-02. If PFL512241-02 shows up one time, then I want to ignore it since I only want products that showed up more than 1 time. I am also calculating occurrence for each product.
Now my codes will only get me the product codes without ** so I need help on that part.
Option Explicit
Sub ProductNumT()
'Set up'
Dim LR1, LR2, LR3, LR4, LR5, LR6, LR7, LR8, LR9, i, j, k, l, m, n As Long
Dim Rng1, Rng2, Rng3, Rng4, cell As Range
Dim Selection, CBA, PNT As Worksheet
Set CBA = Worksheets("Master")
Set PNT = Worksheets("ProductNumT")
Set Selection = Worksheets("Selection")
LR1 = CBA.Cells(Rows.Count, "A").End(xlUp).Row
'Clear values
PNT.Columns("A:J").ClearContents
'Find products
With CBA.Range("C2", "C" & LR1)
.AutoFilter
.AutoFilter Field:=14, Criteria1:=Selection.Range("B6").Value
.Copy
PNT.Range("B2").PasteSpecial Paste:=xlPasteValues
.AutoFilter
End With
'Sort
PNT.Range("B2", "B" & LR1).Sort _
Key1:=Range("B1"), Order1:=xlAscending
'Product w/o location
LR2 = PNT.Cells(Rows.Count, "B").End(xlUp).Row
With PNT.Range("C2", "C" & LR2)
.FormulaR1C1 = "=LEFT(RC[-1],9)"
.Value = .Value
End With
For k = 2 To LR2
PNT.Cells(k, 1).Value = 1
Next k
'Find duplicates & extract unique values from the list
PNT.Range("D2", "D" & LR2).Formula = "=SUMIFS(C1,C3,RC[-1])"
PNT.Range("D2", "D" & LR2).Copy
PNT.Range("D2").PasteSpecial Paste:=xlPasteValues
For i = 2 To LR2
If PNT.Cells(i, 4).Value <= 1 Then
PNT.Rows(i).ClearContents
End If
Next i
PNT.Range("B1").ClearContents
PNT.Range("D2", "D" & LR2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
PNT.Range("C2", "C" & LR1).Copy
PNT.Range("E2").PasteSpecial Paste:=xlPasteValues
PNT.Range("E2", "E" & LR1).RemoveDuplicates Columns:=1, Header:=xlNo
'Main calculation
LR4 = PNT.Cells(Rows.Count, "E").End(xlUp).Row
With PNT.Range("F2", "F" & LR4)
.FormulaR1C1 = "=INDEX(C2,MATCH(RC[-1],C3,0))"
.Value = .Value
End With
With PNT.Range("G2", "G" & LR4)
.FormulaR1C1 = "=INDEX(C4,MATCH(RC[-1],C2,0))"
.Value = .Value
End With
End Sub
First picture is what I have now, and second picture is my desire results.

Answer 1

I believe the following formula should work for column F
.FormulaR1C1 = "=INDEX(C2,MATCH(RC[-1],C3,0))&IF(COUNTIF(C2,INDEX(C2,MATCH(RC[-1],C3,0)))<COUNTIF(C3,RC[-1]),""**"","""")"
It counts how many occurrences there are of PFL180437-02 (for instance) in column B and, if that is less than the number of occurrences of PFL180437 in column C (and therefore there is some other PFL180437-xx), it appends an "**".

Answer 2

Not an answer, but ...
Dim LR1, LR2, LR3, LR4, LR5, LR6, LR7, LR8, LR9, i, j, k, l, m, n As Long
Dim Rng1, Rng2, Rng3, Rng4, cell As Range
Dim Selection, CBA, PNT As Worksheet
Selection is a VBA object. You can't have a variable by that name.
In the first line, only n is a Long. All the others are undefined, meaning variants. In the second line, only cell is a range, all others undefined and therefore variants. In the third line, only PNT is a worksheet, all others undefined and therefore variants.