none
how to assign a serial numbers with unique value RRS feed

  • Question

  • I have a spreadsheet with more than 15000 rows which contain many duplicated data.

    But I can't delete any one of them.

    I want to add one column and assign a serial number in a unique value and a cell with how much unique value in  total 

    It takes a lot of time if using a formula, would anyone tell me how to use VBA to reach it ?

    Thanks

    Example:          4

    DATA              number

    ABC345       1

    SDE124        2

    WER567       3

    YUI789         4

    ABC345        1

    YUI789         4

    SED124       2

    Wednesday, August 8, 2018 1:27 PM

Answers

  • Hello Ksedchen,

    Check if below code helpful for you

    Sub Test()
    Application.ScreenUpdating = False
    Dim SourceSheet As Worksheet
    Set SourceSheet = ActiveSheet
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, 1).End(xlUp).Row
    SourceSheet.Range("B2:B" & LastRow).Delete
    For i = 2 To LastRow
    DataStr = SourceSheet.Cells(i, 1)
    On Error Resume Next
    MatchNum = WorksheetFunction.VLookup(DataStr, SourceSheet.Columns("A:B"), 2, 0)
    If MatchNum = "" Then
    MatchNum = WorksheetFunction.Max(SourceSheet.Columns(2)) + 1
    End If
    SourceSheet.Cells(i, 2) = MatchNum
    Next i
    Application.ScreenUpdating = True
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by ksedchen Thursday, August 9, 2018 9:33 AM
    Thursday, August 9, 2018 6:40 AM

All replies

  • you want to do this in the same dataset or another?

    if another, you could use a pivottable to count you values?

    Wednesday, August 8, 2018 1:44 PM
  • Yes, I want the number in a specific column in the same data.

    If I use <g class="gr_ gr_66 gr-alert gr_spell gr_inline_cards gr_disable_anim_appear ContextualSpelling ins-del multiReplace" data-gr-id="66" id="66">pivottable</g> still can't auto assign the number.

    do you have any other way?

    Thursday, August 9, 2018 4:10 AM
  • Hello Ksedchen,

    Check if below code helpful for you

    Sub Test()
    Application.ScreenUpdating = False
    Dim SourceSheet As Worksheet
    Set SourceSheet = ActiveSheet
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, 1).End(xlUp).Row
    SourceSheet.Range("B2:B" & LastRow).Delete
    For i = 2 To LastRow
    DataStr = SourceSheet.Cells(i, 1)
    On Error Resume Next
    MatchNum = WorksheetFunction.VLookup(DataStr, SourceSheet.Columns("A:B"), 2, 0)
    If MatchNum = "" Then
    MatchNum = WorksheetFunction.Max(SourceSheet.Columns(2)) + 1
    End If
    SourceSheet.Cells(i, 2) = MatchNum
    Next i
    Application.ScreenUpdating = True
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by ksedchen Thursday, August 9, 2018 9:33 AM
    Thursday, August 9, 2018 6:40 AM
  • Hello Terry,

    That's exactly what I want, that's very cool.

    But I want the number start from J4  instead of B2 column.

    Can you fix the code for me? I really don't know how to fix it.

    Thanks a lot. 

    Thursday, August 9, 2018 9:44 AM
  • Hello ksedchen,

    Check if the adjusted code could work for you. If not, please share a screen shot to let us know the layout of your data.

    Sub Test()
    Application.ScreenUpdating = False
    Dim SourceSheet As Worksheet
    Set SourceSheet = ActiveSheet
    LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, 1).End(xlUp).Row
    SourceSheet.Range("J4:J" & LastRow).Delete
    For i = 4 To LastRow
    DataStr = SourceSheet.Cells(i, 1)
    On Error Resume Next
    MatchNum = WorksheetFunction.VLookup(DataStr, SourceSheet.Columns("A:J"), 10, 0)
    If MatchNum = "" Then
    MatchNum = WorksheetFunction.Max(SourceSheet.Columns(10)) + 1
    End If
    SourceSheet.Cells(i, 10) = MatchNum
    Next i
    Application.ScreenUpdating = True
    End Sub

    For sharing file, you could share the file via Cloud Storage, such as One Drive, and then put link address here. Thanks for understanding.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, August 9, 2018 9:58 AM
  • Hello Terry,

    Here is my file, my question mark in red.

    https://1drv.ms/f/s!AgmWTLenCQdngQTgw0TqTJt7t1uc

    I very appreciate your big help.

    Thank you.

    Thursday, August 9, 2018 1:39 PM