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

TAPS_MikeDion

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

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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]
 
Upvote 0
Awesome!
Thanks to all of you for replying with things to try. I'll go through them and let you know how it went.
 
Upvote 0
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
 
Upvote 0
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. :oops:
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top