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

TAPS_MikeDion

Well-known Member
Joined
Aug 14, 2009
Messages
524
Office Version
2011
Platform
MacOS
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

Code:
    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
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
942
Office Version
2007
Platform
Windows
Hi there. I think it can be simpler. Try this:
Code:
    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
 
Last edited:

jmacleary

Well-known Member
Joined
Oct 5, 2015
Messages
942
Office Version
2007
Platform
Windows
OOps slight problem if all numbers are contiguous - this should do it though:
Code:
    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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,719
Office Version
365
Platform
Windows
Not simpler, but should be quicker
Code:
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

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
Another way:
I assumed:
1. the minimum value must be 1
2. numbers in col A are unique

Code:
[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

Well-known Member
Joined
Aug 14, 2009
Messages
524
Office Version
2011
Platform
MacOS
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

Well-known Member
Joined
Aug 14, 2009
Messages
524
Office Version
2011
Platform
MacOS
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,719
Office Version
365
Platform
Windows
. 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

Well-known Member
Joined
Aug 14, 2009
Messages
524
Office Version
2011
Platform
MacOS
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. :banghead:
 

Watch MrExcel Video

Forum statistics

Threads
1,099,124
Messages
5,466,828
Members
406,501
Latest member
TheoDoc

This Week's Hot Topics

Top