How to use Excel VBScript o set auto running number when found duplicate on row's data

How to use Excel VBScript o set auto running number when found duplicate on row's data

I have a set of data at column A is the Code which i need to reassigned a new set of running number with text prefix follow by running in the event when row found have duplicate records.

Please find my below example in excel file on Column A is my raw data and coloumn B is the result what i want to get.

regars,

Anney
   A  B
1  Code  Result numbering
2  39100045  39100045
3  39100045S00  39100045S001
4  39100045S00  39100045S002
5  39100045S00  39100045S003

6
 39100045S00  

39100045S004

Sub Test()
  Dim Data, This
  Dim i As Long, c As Long
 
  'Get all data from column A
  Data = Range("A1", Range("A" & Rows.Count).End(xlUp))
  'Visit each
  For i = 2 To UBound(Data)
    'Duplicate record?
    If Data(i, 1) = Data(i - 1, 1) Then
      'Remember it
      This = Data(i, 1)
      'Restart renumbering
      c = 1
      'Renumber the first
      Data(i - 1, 1) = Data(i - 1, 1) & c
    End If
    'Previous duplicate record?
    If Data(i, 1) = This Then
      'Renumber it
      c = c + 1
      Data(i, 1) = Data(i, 1) & c
    End If
  Next
  'Write the result in column B
  Range("B1").Resize(UBound(Data), UBound(Data, 2)) = Data
End Sub

Copyright © 2007-2012 www.chuibin.com Chuibin Copyright