Add unique number to excel datasheet using VBA

Question

I have two columns of numbers, together they will be unique (composite key). I would like to create an unique ID number (third column) similar to how MS Access would use a primary key. I would like to do this in VBA but I am stuck on how to do it.

My VBA in excel isn't very good so hopefully you can see what I've started to attempt. it may be completely wrong... I don't know?

I don't know how to make the next concatenation and I am unsure about how to go down to the next row correctly.

Sub test2()

Dim var As Integer
Dim concat As String

concat = Range("E2").Value & Range("F2").Value

var = 1

'make d2 activecell
Range("D2").Select

Do Until concat = ""
    'if the concat is the same as the row before we give it the same number
    If concat = concat Then
        var = var
    Else
        var = var + 1
    End If
    ActiveCell.Value = var
    ActiveCell.Offset(0, 1).Select
    'make the new concatination of the next row?
Loop
End Sub

any help is appreciated, thanks.

In which column do you want to write the `concat` value, with your current code, the cell `E2` is overwritten. — SilentRevolution, Jan 19 '16 at 09:13
@SilentRevolution - doesn't it go into the ActiveCell (e.g. D2) ? — , Jan 19 '16 at 09:19
@Jeeped, sorry I misread but no, the variable, number value is written to d2 not the concat value — SilentRevolution, Jan 19 '16 at 09:20
the `concat` is of cells E2 and F2 initally, with ID=1 (cell D2) then I want to go to the next row... if `concat` of E3 and F3 is the same as E2 and F2 then ID also =1, if not ID=2 (cell D3). and then the next row. — LiamH, Jan 19 '16 at 09:23
I see, I assumed you wanted to write the concatenated value to cell. — SilentRevolution, Jan 19 '16 at 09:25
yes they will. In my case I don't think it matters. As long as they have a unique key, successive numbers are ok. — LiamH, Jan 19 '16 at 10:38

SilentRevolution · Accepted Answer · 2016-01-19T09:55:50.090

3

Give the code below a try, I've added a loop which executes for each cell in the E Column. It checks if the concat value is the same as the concat value in the row above and then writes the id to the D cell.

Sub Test2()
    Dim Part1 As Range
    Dim strConcat As String
    Dim i As Long

    i = 1

    With ThisWorkbook.Worksheets("NAME OF YOUR SHEET")
        For Each Part1 In .Range(.Cells(2, 5), .Cells(2, 5).End(xlDown))
            strConcat = Part1 & Part1.Offset(0, 1)

            If strConcat = Part1.Offset(-1, 0) & Part1.Offset(-1, 1) Then
                Part1.Offset(0, -1).Value = i
            Else
                i = i + 1
                Part1.Offset(0, -1).Value = i
            End If
        Next Part1
    End With
End Sub

edited Jan 19 '16 at 09:55

answered Jan 19 '16 at 09:31

SilentRevolution

1,495
1
16
31

Yeah that it should be, the first concatenated value gets ID 1, every subsequent concatenated value that is different from the one above it should get a different ID. – SilentRevolution Jan 19 '16 at 10:06
I have found this answer to be the most intuitive and easiest to understand. It works perfectly for what I was wanting to achieve! If anyone thought my question was slightly misleading (which I apologise for) this should explain what was trying to produce. – LiamH Jan 19 '16 at 10:59

score 2 · Answer 2 · answered Jan 19 '16 at 09:30

2

Something like this should work, this will return a Unique GUID (Globally Unique Identifier):

Option Explicit
Sub Test()

    Range("F2").Select

    Do Until IsEmpty(ActiveCell)

        If (ActiveCell.Value <> "") Then
            ActiveCell.Offset(0, 1).Value = CreateGUID
        End If
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub
Public Function CreateGUID() As String
    CreateGUID = Mid$(CreateObject("Scriptlet.TypeLib").GUID, 2, 36)
End Function

answered Jan 19 '16 at 09:30

Matt D. Webb

3,216
4
29
51

I like this function and I'm going to save it if you don't mind. Initially I thought the same as you but the OP wants to compare concatenated values with concatenated values in the row above. – SilentRevolution Jan 19 '16 at 09:39
My assumption was he was making the comparison to ensure the value in the third column was unique, this way doesn't have to check, it will always generate a unique id. – Matt D. Webb Jan 19 '16 at 09:42
Cool, what's it supposed to do though? – Davesexcel Jan 19 '16 at 09:57
@Davesexcel "Add unique number to excel datasheet using VBA" – Matt D. Webb Jan 19 '16 at 10:06
Yep, I thought the OP wanted to have unique numbers for unique items. – Davesexcel Jan 19 '16 at 10:21
@Davesexcel think the question is open to misinterpretation so it's perfectly likely this is not the solution he requires. :-) – Matt D. Webb Jan 19 '16 at 10:23

score 2 · Answer 3 · answered Jan 19 '16 at 09:31

If you walk down column D and examine the concatenated values from column E and F with the previous row, you should be able to accomplish your 'primary key'.

Sub priKey()
    Dim dcell As Range

    With Worksheets("Sheet12")
        For Each dcell In .Range(.Cells(2, 4), .Cells(Rows.Count, 5).End(xlUp).Offset(0, -1))
            If LCase(Join(Array(dcell.Offset(0, 1).Value2, dcell.Offset(0, 2).Value2), ChrW(8203))) = _
               LCase(Join(Array(dcell.Offset(-1, 1).Value2, dcell.Offset(-1, 2).Value2), ChrW(8203))) Then
                dcell = dcell.Offset(-1, 0)
            Else
                dcell = Application.Max(.Range(.Cells(1, 4), dcell.Offset(-1, 0))) + 1
            End If
        Next dcell
    End With
End Sub

Yes, I am well aware of that. My intention this time around was to get the OP's original method working; not to rewrite it. — , Jan 19 '16 at 10:48

score 1 · Answer 4 · answered Jan 19 '16 at 09:42

You could use collections as well.

    Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range, LstRw As Long
    Dim Cell As Range
    Dim vNum As Variant, c As Range, y

    LstRw = Cells(Rows.Count, "E").End(xlUp).Row
    Set Rng = Range("E2:E" & LstRw)
    Set cUnique = New Collection

    On Error Resume Next
    For Each Cell In Rng.Cells
        cUnique.Add Cell.Value & Cell.Offset(, 1), CStr(Cell.Value & Cell.Offset(, 1))
    Next Cell
    On Error GoTo 0
    y = 1

    For Each vNum In cUnique
        For Each c In Rng.Cells
            If c & c.Offset(, 1) = vNum Then
                c.Offset(, -1) = y
            End If
        Next c
        y = y + 1

    Next vNum

End Sub

Add unique number to excel datasheet using VBA

4 Answers4

Linked