Infinite Loop problem

[albasel]

Good day everybody

I need to do a code to go down in a column A ,as an example, and check if the current cell value is the same with previous the counter should be increment by one else it goes and print in the next column B the value of column A + (1 up to counter). It should go until the the cell is empty.
The problem with my code that the loop becomes infinite for the first set of similar number.
Can any body help me?


Sub Macro3()
Dim pNo As Integer
Dim counter As Integer
Dim k As Integer
Dim sum As Integer
Dim num As Integer
Dim addr1 As String
Dim addr2 As String
mCounter = 1
addr1 = ActiveCell.Address
pNo = Selection.Value
Selection.Offset(1, 0).Select
Do While Selection.Value <> ""
If pNo = ActiveCell.Value Then
Selection.Offset(1, 0).Select
counter = counter + 1
Else
addr2 = ActiveCell.Offset(-1, 0).Address
Range(addr1).Select
Selection.Offset(0, 3).Select
For k = 1 To counter
Selection.Value = Range(addr1).Value & k
Selection.Offset(1, 0).Select
Next k
counter = 1
Range(addr2).Select
End If
Loop
End Sub

[Bob Phillips]

Sub Macro3()
Dim lastrow As Long
Dim outrow As Long
Dim col As Long
Dim pNo As Long
Dim counter As Long
Dim i As Long, k As Long
counter = 1
With ActiveSheet
col = ActiveCell.Column
lastrow = .Cells(.Rows.Count, col).End(xlUp).Row
pNo = .Cells(1, col).Value
For i = 2 To lastrow + 1
If .Cells(i, col).Value = pNo Then
counter = counter + 1
Else
For k = 1 To counter
outrow = outrow + 1
.Cells(outrow, col + 3).Value = pNo & k
Next k
counter = 1
pNo = .Cells(i, col).Value
End If
Next i
End With
End Sub

[snb]

or ?


Sub snb()
[B1:B200] = [if(countif(offset(A1,,,row(1:200)),A1:A200)=1,countif(A1:A200,A1:A200),"")]
End Sub