Counting a Numerical Sequence

  • Thread starter Thread starter Rick D
  • Start date Start date
R

Rick D

I submitted a question several weeks ago and I did receive
several solutions - one of which I used (thank you to
whoever posted them). However, now we need to take it to
the next level.
I have a column of phone extensions. Valid numbers are
1000-9999, however, not all of these extension numbers are
being used. We want an automated way of having a separate
column display all of the available (free) numbers that do
not show up in this numerical sequence.

So what I have currently is column A listing all of the
extensions. Column B is where the following formula is:
=IF(A1<>A2-1, A1+1,0). I drag this formula down the column
to match the length of the numbers in column A.
This will either give me a 0 if there is no missing number
in the sequence, or the missing number. So for instance,
this is a sample of what I get in columns A & B:

1000 0
1001 0
1002 1003
1005 1006
1007 0
1008 0
1009 0
1010 0

Unfortunately as you can see, this only gives me the first
number in the gap. I could drag the formula to the right
into subsequent columns and this will display more missing
numbers, but if there is a gap of 50 free numbers, that
doesn't really make it easy to display or print out.

Therefore, I would like to know if there's a way of having
a column set up to report (say, Column C), from top to
bottom, all of the available extensions from Column A.
I'm assuming that it would need to count the numbers in
Column A and determine the length of each missing number
gap, and from there, be able to spit back what those
numbers are.

I'm not a coder, so I hope I explained this simply enough!
Any help would be greatly appreciated on this.
Thanks.

-Rick
 
why not a macro to add rows with the missing numbers and color code the
missing?
 
Rick,

Here's one other option for your consideration. Display missing
numbers or a range if there are more than two ie:
1000
1001
1002 1003, 1004
1005 1006
1007
1008
1009
1010 1011 - 1014
1015

So if your list started in A1, in B1:
=IF(A2-A1=2,A2-1,IF(A2-A1=3,A2-2 & ", " & A2-1,IF(A2-A1>3,A1+1 & " - " & A2-1,"")))
and copy down

Dan E
 
I would assume a fairly easy way to do this is to create a help column,
assume your taken extensions
are in A2:A500, create a help column that starts with the first extension
from A2 and increment by 1,
(put the first number in B2, select the lower right corner of B2 and right
click and copy down, release mouse button and select fill series) assume
this help column will be from B2:B550. Now in C2 put this formula

=IF(COUNTIF($A$2:$A$500,B2)=0,B2,"")

copy down to C550 by double clicking the lower right corner of C2, that will
give you
all the free extensions in column C, then you could apply autofilter on C
and filter on nonblanks,
then just select the visible numbers and copy them somewhere else as values
(edit>paste special as value), then delete all the help columns
 
Rick D,

The following routine assumes that you have the following

A1="Used Extensions" A2...onwards...your used extensions
B1="Avail Extensions"

Here is a quick subroutine....

Sub FindAvailExt()
Dim rnExtUsed As Range
Dim rnCell As Range
Dim iCounter1 As Integer
Dim iCounter2 As Integer
Dim iMatchIndex As Integer

Set rnExtUsed = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

iCounter2 = 2

On Error Resume Next

For iCounter1 = 1000 To 9999
iMatchIndex = Application.WorksheetFunction.Match(iCounter1,
rnExtUsed, 0)
If Err.Number <> 0 Then
Cells(iCounter2, "B") = iCounter1
iCounter2 = iCounter2 + 1
Err.Number = 0
End If
Next iCounter1

It will place in order all the available extensions in Col B starting in row
2 and will proceed contiguously.

If anyone has any pointers to tighten or improve the above routine, I am
most interested in seeing the improvement. I am not a wizard at VBA, so I
enjoy seeing better solutions.

To enter the routine...

1) Alt F11
2) Insert Module
3) Copy and paste above into module
4) Back to the worksheet
5) Alt F8
6) Select FindAvailExt

Hope that helps.

Regards,
Kevin
 
Whoops, didn't properly copy all the subrountine..missed the end sub

Please be careful of line wrap.

Sub FindAvailExt()

Dim rnExtUsed As Range
Dim rnCell As Range
Dim iCounter1 As Integer
Dim iCounter2 As Integer
Dim iMatchIndex As Integer

Set rnExtUsed = Range(Cells(1, "A"), Cells(Rows.Count, "A").End(xlUp))

iCounter2 = 2

On Error Resume Next

For iCounter1 = 1000 To 9999
iMatchIndex = Application.WorksheetFunction.Match(iCounter1,
rnExtUsed, 0)
If Err.Number <> 0 Then
Cells(iCounter2, "B") = iCounter1
iCounter2 = iCounter2 + 1
Err.Number = 0
End If
Next iCounter1

End Sub
 
Hi,

Assuming your source (column A) is in ascending order.

Regards,

Daniel M.

Sub DisplayMissing3()
Dim C As Range, V As Variant
Dim prev&, k&, n&

k = 1
prev = 999 ' one less than beginning, here 1000
For Each C In Intersect(Range("A:A"), ActiveSheet.UsedRange)
If C > prev + 1 Then ' some numbers left
V = Evaluate("ROW(" & prev + 1 & ":" & C - 1 & ")")
n = C - (prev + 1)
Cells(k, "C").Resize(n, 1) = V
k = k + n
End If
prev = C
Next C

' do the last ones, aka from the highest to 9999
If prev < 9999 Then
V = Evaluate("ROW(" & prev + 1 & ":9999)")
n = 9999 - prev
Cells(k, "C").Resize(n, 1) = V
End If

End Sub
 
Back
Top