VBA require to find missing numbers

[motilulla]

Hello,

I need VBA for following task numbers are in column “A” if I select prior or code provide selection option after it is run for example I select the range A11:A23 Highlighted in yellow VBA find Min & Max range in selection and list missing number in column C as shown.

In given example in the selected range lowest number is 2 and highest number is 15 find missing between (2-15) in column C

Book1
	A	B	C
1	Numbers		Missing Numbers
2	16		5
3	7		8
4	14		10
5	4		12
6	15		13
7	33
8	3
9	4
10	1
11	14
12	6
13	2
14	15
15	7
16	15
17	6
18	9
19	2
20	11
21	3
22	4
23	2
24	24
25	7
26	9
27	5
28	20
Sheet1

Thanks In Advance

Regards,
Moti

 

[MickG]

Try this:-
Select range in column "A" and run code !!!!

[COLOR=Navy]Sub[/COLOR] MG17Jan41
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] oMax [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] oMin [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Tem [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
c = 1
[COLOR=Navy]Set[/COLOR] Rng = Selection
[COLOR=Navy]If[/COLOR] Not Selection.Column = 1 [COLOR=Navy]Then[/COLOR]
    MsgBox "Please [COLOR=Navy]Select[/COLOR] range in column ""A""" & Chr(10) & "and Re-run this code"
[COLOR=Navy]Exit[/COLOR] [COLOR=Navy]Sub[/COLOR]
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
 Dic.CompareMode = vbTextCompare
    [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Selection: Dic(Dn.Value) = Empty: [COLOR=Navy]Next[/COLOR]
     oMax = Application.Max(Dic.keys)
      oMin = Application.Min(Dic.keys)
    
Tem = Range("C1").Value: Range("C:C").ClearContents: Range("C1").Value = Tem
    [COLOR=Navy]For[/COLOR] n = oMin To oMax
        [COLOR=Navy]If[/COLOR] Not Dic.exists(n) [COLOR=Navy]Then[/COLOR]
            c = c + 1
            Cells(c, "C") = n
          [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[motilulla]

Try this:-
Select range in column "A" and run code !!!!
Regards Mick

Thank you very much Mick, it is working Brilliant!!

Regards,
Moti

 

[MickG]

You're welcome