problem auto numbering in column

hello 

I  have  this  code   merges duplicates  items  based  on  column B  and  summing the  values  in column C  but  I  need  after  merging  should  arrange  the  numbers  again  in  column A  1,2,3.... . I  put  this  line   in  the  end  of  the  code

 Columns(1) = Evaluate("row(1:" & Rows.Count & ")")

  but  the  problem  auto-numbers for  all  of  cells  in  column A  even  if  there  is  no  data  in  column B,  so  what  I  want  just  auto-number  based  on  filled cells  in column B  .

this  is  the  code 

Sub mergeitems()
Dim Rng As Range, Dn As Range, n As Long, nRng As Range, ws As Worksheet
Set Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

For Each Dn In Rng
    If Not .Exists(Dn.Value) Then
        .Add Dn.Value, Dn
    Else
        If nRng Is Nothing Then Set nRng = _
        Dn Else Set nRng = Union(nRng, Dn)
        .Item(Dn.Value).Offset(, 1) = .Item(Dn.Value).Offset(, 1) + Dn.Offset(, 1)
    End If
Next
If Not nRng Is Nothing Then nRng.EntireRow.Delete
End With
 Columns(1) = Evaluate("row(1:" & Rows.Count & ")")
End Sub

any  idea  to  adjust  the  code ,-please?