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

#### TAPS_MikeDion

##### Well-known Member
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
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

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
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
NextEmpNum = xNum
Exit For
End If
Next x
End With``````

Last edited:

#### jmacleary

##### Well-known Member
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
NextEmpNum = xNum
Exit For
End If
Next x

End With``````

#### Fluff

##### MrExcel MVP, Moderator
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)
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
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
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
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
. 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
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: