Missing Numbers

[Soniya]

Hi All,

Ho can i have a macro to find missing numbers from a
serial; to get a result something like..

COLUMNA CLOMN B

DATA RESULT
100 103
101 104
102 108
105 109
106
107
110

TIA
Soniya

 

[Colo]

Hi Soniya, here is a simple LOOP code.


Code:
--------------------

Sub Test()
Dim i As Long, j As Long
i = 1
For Each c In Range([A2], [A65536].End(xlUp))
If c.Offset(1).Value = "" Then Exit For
j = c.Value
Do Until j = c.Offset(1).Value - 1
j = j + 1: i = i + 1
Cells(i, 2).Value = j
Loop
Next
End Sub

--------------------

 

[Patrick Molloy]

Use two loops.
A do_Loop for the main column and a For..Next loop for
the gaps.
Method. Given the value of two cells a & b, the missing
numbers are any between, A...A+1...A+2...b-2...b-1

The following code assumes integers in A from row 2 and
places the missing numbers in B from row 2, assumning
headers in row 1 as per your example.
I suggest ALWAYS use Option Explicit ... it helps
debugging, and use variable names that are meaningful if
you can

Option Explicit
Sub FindMissing()
Dim ThisRow As Long ' index for the lookup column
Dim ThisValue As Long ' value if the cell at index
Dim NextValue As Long ' value of the next cell
Dim ResultRow As Long ' target row for placing result

' initialise rows
ThisRow = 2
ResultRow = 1

Do While Cells(ThisRow + 1, "A").Value <> ""

' get th ecell value and the next cell value
ThisValue = Cells(ThisRow, "A").Value
NextValue = Cells(ThisRow + 1, "A").Value

' get any missing numbers
For ThisValue = ThisValue + 1 To NextValue - 1
' increment th etarget row index
ResultRow = ResultRow + 1
' place the missing value in the result column
Cells(ResultRow, "B").Value = ThisValue
Next

' increment the loop counter
ThisRow = ThisRow + 1
Loop


End Sub


HTH

Patrick Molloy
Microsoft Excel MVP

 

[Shailesh Shah]

Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/

 

[Shailesh Shah]

Hi,

Try this to speed up Colo's Code with array.

Sub Test_colo()
Dim i As Long, j As Long, varr()
i = 0
For Each c In Range([A2], [A65536].End(xlUp))
If c.Offset(1).Value = "" Then Exit For
j = c.Value
Do Until j = c.Offset(1).Value - 1
j = j + 1
ReDim Preserve varr(i)
varr(i) = j
i = i + 1
Loop
Next
[b2].Resize(UBound(varr, 1) + 1, 1) = Application.Transpose(varr)
End Sub


Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/

 

[Dana DeLouis]

I seem to get "slightly" better performance with the following idea by just
a hair. Needs XL 2000 or better due to "Filter."

Sub Demo()
'// Dana DeLouis
Dim v1, v2
Dim j As Long
With WorksheetFunction
v1 = .Transpose(Range([A2], [A2].End(xlDown)))

ReDim v2(.Min(v1) To .Max(v1))
For j = LBound(v2) To UBound(v2)
v2(j) = j
Next

For j = LBound(v1) To UBound(v1)
v2(v1(j)) = "x"
Next

v2 = Filter(v2, "x", False)
[b2].Resize(UBound(v2) + 1) = .Transpose(v2)
End With
End Sub