Is there a shorter way to find the next available number?

[TAPS_MikeDion]

Hi everybody,

Below is the code I'm using (it does work) to find the next available number in a series of numbers in column A. I search through column A, find the missing numbers, put them into an array and then find the smallest number in the array.

Is there is a more simplified/efficient way of doing it?

Thanks!

xNum = existing number
mNum = missing number
mArr() = missing numbers array
NextEmpNum = next employee number

    Dim x As Long, x2 As Long
    Dim xNum As Long, mNum As Long
    Dim Found As Boolean
    Dim mArr() As Integer
    
    Set ws = Sheets("DataSheet")
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    With ws
        xNum = 0
        mNum = -1
        For x = 2 To LastRow
            Found = False
            xNum = xNum + 1
            For x2 = 2 To LastRow
                If xNum = Cells(x2, 1) Then Found = True
            Next x2
            If Not Found Then
                mNum = mNum + 1
                ReDim Preserve mArr(mNum)
                mArr(mNum) = xNum
            End If
        Next x
        If mNum > 1 Then
            NextEmpNum = WorksheetFunction.Min(mArr)
        Else
            NextEmpNum = 1
        End If
    End With

 

[jmacleary]

Hi there. I think it can be simpler. Try this:

    Dim x As Long, x2 As Long
    Dim xNum As Long, mNum As Long
    Dim Found As Boolean
    Dim mArr() As Integer
    
    Set ws = Sheets("DataSheet")
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    With ws
        xNum = 0
        mNum = -1
        NextEmpNum = 1
        For x = 2 To LastRow
            Found = False
            xNum = xNum + 1
            For x2 = 2 To LastRow
                If xNum = Cells(x2, 1) Then Found = True
            Next x2
            If Not Found Then
                NextEmpNum = xNum
                Exit For
            End If
        Next x
End With

 

[jmacleary]

OOps slight problem if all numbers are contiguous - this should do it though:

    Dim x As Long, x2 As Long
    Dim xNum As Long, mNum As Long
    Dim Found As Boolean
    Dim mArr() As Integer
    
    Set ws = Sheets("DataSheet")
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    With ws
        xNum = 0
        mNum = -1
        NextEmpNum = LastRow + 1
        For x = 2 To LastRow
            Found = False
            xNum = xNum + 1
            For x2 = 2 To LastRow
                If xNum = Cells(x2, 1) Then Found = True
            Next x2
            If Not Found Then
                NextEmpNum = xNum
                Exit For
            End If
        Next x

    End With

 

[Fluff]

Not simpler, but should be quicker

Sub Taps()
    Dim ary As Variant
    Dim i As Long, Nxt As Long
    Dim Lst As Object
    
    Set Lst = CreateObject("system.collections.arraylist")
    With Sheets("sheet1")
        ary = .Range("A2", Range("A" & Rows.Count).End(xlUp)).Value2
    End With
    For i = 1 To UBound(ary)
        Lst.Add ary(i, 1)
    Next i
    Lst.Sort
    If Lst(0) > 1 Then
        Nxt = 1
    Else
        For i = 1 To Lst.Count - 1
            If Lst(i) <> Lst(i - 1) + 1 Then
                Nxt = Lst(i - 1) + 1
                Exit For
            End If
        Next i
    End If
    If Nxt = 0 Then Nxt = Lst(i - 1) + 1
    MsgBox Nxt
End Sub

 

[Akuini]

Another way:
I assumed:
1. the minimum value must be 1
2. numbers in col A are unique

[FONT=Lucida Console][COLOR=Royalblue]Sub[/COLOR] a1113629a()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] va
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]

va = Range([COLOR=Darkcyan]"A2"[/COLOR], Cells(Rows.count, [COLOR=Darkcyan]"A"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=Darkcyan]"scripting.dictionary"[/COLOR])
    
    [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=Royalblue]UBound[/COLOR](va, [COLOR=Brown]1[/COLOR])
        d(i) = [COLOR=Royalblue]Empty[/COLOR]
    [COLOR=Royalblue]Next[/COLOR]

    [COLOR=Royalblue]For[/COLOR] i = [COLOR=Brown]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=Royalblue]UBound[/COLOR](va, [COLOR=Brown]1[/COLOR])
        [COLOR=Royalblue]If[/COLOR] d.Exists(va(i, [COLOR=Brown]1[/COLOR])) [COLOR=Royalblue]Then[/COLOR] d.Remove (va(i, [COLOR=Brown]1[/COLOR]))
    [COLOR=Royalblue]Next[/COLOR]
    
    [COLOR=Royalblue]If[/COLOR] d.count = [COLOR=Brown]0[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        Debug.Print [COLOR=Royalblue]UBound[/COLOR](va, [COLOR=Brown]1[/COLOR]) + [COLOR=Brown]1[/COLOR]
    [COLOR=Royalblue]Else[/COLOR]
        Debug.Print WorksheetFunction.Min(d.Keys)
    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
    
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR]
[/FONT]

 

[TAPS_MikeDion]

Awesome!
Thanks to all of you for replying with things to try. I'll go through them and let you know how it went.

 

[TAPS_MikeDion]

Okay, I tried all three. The only one that worked was the code from jmacleary.

When I tried the code from Fluff and Akuini, I received the same error. I'm wondering if it's because I'm running a Mac.

Run-time error '429':
ActiveX component can't create object

Thanks,
Mike

 

[Fluff]

. I'm wondering if it's because I'm running a Mac.

That would indeed be the reason. It's always best to let people know you're using a Mac, to avoid wasting their time

 

[TAPS_MikeDion]

Yup, no problem. My apologies.

I am not happy with it (talked into it by my boss.) I'm trying to get him to buy me a PC so VB/VBA things actually work.