Find Missed and Duplicated Numbers

I have a program that finds the missed and duplicated numbers (see below).
The program runs perfectly with numbers only, however, I want to make it run
with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
program tell that 2a is duplicated and 2b is missed.
Could you please tell me if this is possible to do?
Thanks in advance.

Maperalia

‘****START PROGRAM****************************
Sub FindMissingAndDuplicates()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim v() As Long
Dim missing() As Long
Dim i As Long
Dim lastrow As Long


'*****Find the Minimum and Maximum Number*********
sblock = Application.InputBox("Enter block start")
fblock = Application.InputBox("Enter block end")
'*************************************************

ReDim v(fblock - sblock + 1)

j = 0
For i = sblock To fblock
v(j) = i
j = j + 1
Next i

'****Read the Numbers on the Test Numbers Sheet********
Set ws1 = Worksheets("Test Numbers")
'******************************************************

'****Write the Missed and Duplicated Number on the Missing and Duplicated
Numbers Sheet********
Set ws2 = Worksheets("Missing and Duplicated Numbers")
ws2.Range("a1:b1") = Array("Missing", "Duplicated")
'**********************************************************************************************

With ws1
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Range("a1:a" & lastrow)
End With

n1 = 2
n2 = 2
For i = LBound(v) To UBound(v)
If IsError(Application.Match(v(i), rng, 0)) Then
ws2.Cells(n1, 1) = v(i)
n1 = n1 + 1
Else
If Application.CountIf(rng, v(i)) > 1 Then
ws2.Cells(n2, 2) = v(i)
n2 = n2 + 1
End If
End If
Next i
End Sub

‘****END PROGRAM****************************

Try this:

Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
if non-contiguous ("," is used as delimiter)
Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)


HTH


Sub FindMissingAndDuplicates()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim v()
Dim missing() As Long
Dim i As Long
Dim lastrow As Long
Dim x As Variant
Dim rngStr As String


'*****Find the Minimum and Maximum Number*********
rngStr = Application.InputBox("Enter Range")
'*************************************************
n = InStr(1, rngStr, "-", vbTextCompare)
If n <> 0 Then
x = Split(rngStr, "-")
sblock = x(0)
fblock = x(1)
ReDim v(fblock - sblock + 1)

j = 0
For i = sblock To fblock
v(j) = i
j = j + 1
Next i
Else
x = Split(rngStr, ",")
sblock = LBound(x)
fblock = UBound(x)
ReDim v(fblock - sblock + 1)

j = 0
For i = sblock To fblock
If IsNumeric(x(i)) Then
v(j) = CInt(x(i))
Else
v(j) = x(i)
End If
j = j + 1
Next i
End If

'****Read the Numbers on the Test Numbers Sheet********
Set ws1 = Worksheets("Test Numbers")
'******************************************************

'****Write the Missed and Duplicated Number on the Missing and
DuplicatedNumbers Sheet********
Set ws2 = Worksheets("Missing and Duplicated Numbers")
ws2.Range("a1:b1") = Array("Missing", "Duplicated")
'**********************************************************************************************

With ws1
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Range("a1:a" & lastrow)
End With

n1 = 2
n2 = 2
For i = LBound(v) To UBound(v)
If IsError(Application.Match(v(i), rng, 0)) Then
ws2.Cells(n1, 1) = v(i)
n1 = n1 + 1
Else
If Application.CountIf(rng, v(i)) > 1 Then
ws2.Cells(n2, 2) = v(i)
n2 = n2 + 1
End If
End If
Next i
End Sub


"maperalia" wrote:

> I have a program that finds the missed and duplicated numbers (see below).
> The program runs perfectly with numbers only, however, I want to make it run
> with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> program tell that 2a is duplicated and 2b is missed.
> Could you please tell me if this is possible to do?
> Thanks in advance.
>
> Maperalia
>
> ‘****START PROGRAM****************************
> Sub FindMissingAndDuplicates()
>
> Dim ws1 As Worksheet
> Dim ws2 As Worksheet
> Dim v() As Long
> Dim missing() As Long
> Dim i As Long
> Dim lastrow As Long
>
>
> '*****Find the Minimum and Maximum Number*********
> sblock = Application.InputBox("Enter block start")
> fblock = Application.InputBox("Enter block end")
> '*************************************************
>
> ReDim v(fblock - sblock + 1)
>
> j = 0
> For i = sblock To fblock
> v(j) = i
> j = j + 1
> Next i
>
> '****Read the Numbers on the Test Numbers Sheet********
> Set ws1 = Worksheets("Test Numbers")
> '******************************************************
>
> '****Write the Missed and Duplicated Number on the Missing and Duplicated
> Numbers Sheet********
> Set ws2 = Worksheets("Missing and Duplicated Numbers")
> ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> '**********************************************************************************************
>
> With ws1
> lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> Set rng = .Range("a1:a" & lastrow)
> End With
>
> n1 = 2
> n2 = 2
> For i = LBound(v) To UBound(v)
> If IsError(Application.Match(v(i), rng, 0)) Then
> ws2.Cells(n1, 1) = v(i)
> n1 = n1 + 1
> Else
> If Application.CountIf(rng, v(i)) > 1 Then
> ws2.Cells(n2, 2) = v(i)
> n2 = n2 + 1
> End If
> End If
> Next i
> End Sub
>
> ‘****END PROGRAM****************************
>
>
>
>
>
>
>
>

Toppers;
Thanks for the quick response. I ran the program but when it asked me for
the range I typed 1a,2a,3a and then I got the following error message:

RUN TIME ERROR"13"
TYPE MISMATCH

Could you please tell me what I am doing wrong?

Thanks.
Maperalia

"Toppers" wrote:

> Try this:
>
> Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
> if non-contiguous ("," is used as delimiter)
> Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)
>
>
> HTH
>
>
> Sub FindMissingAndDuplicates()
>
> Dim ws1 As Worksheet
> Dim ws2 As Worksheet
> Dim v()
> Dim missing() As Long
> Dim i As Long
> Dim lastrow As Long
> Dim x As Variant
> Dim rngStr As String
>
>
> '*****Find the Minimum and Maximum Number*********
> rngStr = Application.InputBox("Enter Range")
> '*************************************************
> n = InStr(1, rngStr, "-", vbTextCompare)
> If n <> 0 Then
> x = Split(rngStr, "-")
> sblock = x(0)
> fblock = x(1)
> ReDim v(fblock - sblock + 1)
>
> j = 0
> For i = sblock To fblock
> v(j) = i
> j = j + 1
> Next i
> Else
> x = Split(rngStr, ",")
> sblock = LBound(x)
> fblock = UBound(x)
> ReDim v(fblock - sblock + 1)
>
> j = 0
> For i = sblock To fblock
> If IsNumeric(x(i)) Then
> v(j) = CInt(x(i))
> Else
> v(j) = x(i)
> End If
> j = j + 1
> Next i
> End If
>
> '****Read the Numbers on the Test Numbers Sheet********
> Set ws1 = Worksheets("Test Numbers")
> '******************************************************
>
> '****Write the Missed and Duplicated Number on the Missing and
> DuplicatedNumbers Sheet********
> Set ws2 = Worksheets("Missing and Duplicated Numbers")
> ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> '**********************************************************************************************
>
> With ws1
> lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> Set rng = .Range("a1:a" & lastrow)
> End With
>
> n1 = 2
> n2 = 2
> For i = LBound(v) To UBound(v)
> If IsError(Application.Match(v(i), rng, 0)) Then
> ws2.Cells(n1, 1) = v(i)
> n1 = n1 + 1
> Else
> If Application.CountIf(rng, v(i)) > 1 Then
> ws2.Cells(n2, 2) = v(i)
> n2 = n2 + 1
> End If
> End If
> Next i
> End Sub
>
>
> "maperalia" wrote:
>
> > I have a program that finds the missed and duplicated numbers (see below).
> > The program runs perfectly with numbers only, however, I want to make it run
> > with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> > program tell that 2a is duplicated and 2b is missed.
> > Could you please tell me if this is possible to do?
> > Thanks in advance.
> >
> > Maperalia
> >
> > ‘****START PROGRAM****************************
> > Sub FindMissingAndDuplicates()
> >
> > Dim ws1 As Worksheet
> > Dim ws2 As Worksheet
> > Dim v() As Long
> > Dim missing() As Long
> > Dim i As Long
> > Dim lastrow As Long
> >
> >
> > '*****Find the Minimum and Maximum Number*********
> > sblock = Application.InputBox("Enter block start")
> > fblock = Application.InputBox("Enter block end")
> > '*************************************************
> >
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > v(j) = i
> > j = j + 1
> > Next i
> >
> > '****Read the Numbers on the Test Numbers Sheet********
> > Set ws1 = Worksheets("Test Numbers")
> > '******************************************************
> >
> > '****Write the Missed and Duplicated Number on the Missing and Duplicated
> > Numbers Sheet********
> > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > '**********************************************************************************************
> >
> > With ws1
> > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > Set rng = .Range("a1:a" & lastrow)
> > End With
> >
> > n1 = 2
> > n2 = 2
> > For i = LBound(v) To UBound(v)
> > If IsError(Application.Match(v(i), rng, 0)) Then
> > ws2.Cells(n1, 1) = v(i)
> > n1 = n1 + 1
> > Else
> > If Application.CountIf(rng, v(i)) > 1 Then
> > ws2.Cells(n2, 2) = v(i)
> > n2 = n2 + 1
> > End If
> > End If
> > Next i
> > End Sub
> >
> > ‘****END PROGRAM****************************
> >
> >
> >
> >
> >
> >
> >
> >

Hi,
Which statement gives the error? If you are not sure, go into the
code and single shot through it, using F8 key.

I have just re-tested and it works OK for me, given my understanding of your
data. I tried a test with a range of 2a,7 i.e. mixed, and this also worked OK.

If you still have problems, post a sample w/book
([email protected])

HTH

"maperalia" wrote:

> Toppers;
> Thanks for the quick response. I ran the program but when it asked me for
> the range I typed 1a,2a,3a and then I got the following error message:
>
> RUN TIME ERROR"13"
> TYPE MISMATCH
>
> Could you please tell me what I am doing wrong?
>
> Thanks.
> Maperalia
>
> "Toppers" wrote:
>
> > Try this:
> >
> > Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
> > if non-contiguous ("," is used as delimiter)
> > Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)
> >
> >
> > HTH
> >
> >
> > Sub FindMissingAndDuplicates()
> >
> > Dim ws1 As Worksheet
> > Dim ws2 As Worksheet
> > Dim v()
> > Dim missing() As Long
> > Dim i As Long
> > Dim lastrow As Long
> > Dim x As Variant
> > Dim rngStr As String
> >
> >
> > '*****Find the Minimum and Maximum Number*********
> > rngStr = Application.InputBox("Enter Range")
> > '*************************************************
> > n = InStr(1, rngStr, "-", vbTextCompare)
> > If n <> 0 Then
> > x = Split(rngStr, "-")
> > sblock = x(0)
> > fblock = x(1)
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > v(j) = i
> > j = j + 1
> > Next i
> > Else
> > x = Split(rngStr, ",")
> > sblock = LBound(x)
> > fblock = UBound(x)
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > If IsNumeric(x(i)) Then
> > v(j) = CInt(x(i))
> > Else
> > v(j) = x(i)
> > End If
> > j = j + 1
> > Next i
> > End If
> >
> > '****Read the Numbers on the Test Numbers Sheet********
> > Set ws1 = Worksheets("Test Numbers")
> > '******************************************************
> >
> > '****Write the Missed and Duplicated Number on the Missing and
> > DuplicatedNumbers Sheet********
> > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > '**********************************************************************************************
> >
> > With ws1
> > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > Set rng = .Range("a1:a" & lastrow)
> > End With
> >
> > n1 = 2
> > n2 = 2
> > For i = LBound(v) To UBound(v)
> > If IsError(Application.Match(v(i), rng, 0)) Then
> > ws2.Cells(n1, 1) = v(i)
> > n1 = n1 + 1
> > Else
> > If Application.CountIf(rng, v(i)) > 1 Then
> > ws2.Cells(n2, 2) = v(i)
> > n2 = n2 + 1
> > End If
> > End If
> > Next i
> > End Sub
> >
> >
> > "maperalia" wrote:
> >
> > > I have a program that finds the missed and duplicated numbers (see below).
> > > The program runs perfectly with numbers only, however, I want to make it run
> > > with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> > > program tell that 2a is duplicated and 2b is missed.
> > > Could you please tell me if this is possible to do?
> > > Thanks in advance.
> > >
> > > Maperalia
> > >
> > > ‘****START PROGRAM****************************
> > > Sub FindMissingAndDuplicates()
> > >
> > > Dim ws1 As Worksheet
> > > Dim ws2 As Worksheet
> > > Dim v() As Long
> > > Dim missing() As Long
> > > Dim i As Long
> > > Dim lastrow As Long
> > >
> > >
> > > '*****Find the Minimum and Maximum Number*********
> > > sblock = Application.InputBox("Enter block start")
> > > fblock = Application.InputBox("Enter block end")
> > > '*************************************************
> > >
> > > ReDim v(fblock - sblock + 1)
> > >
> > > j = 0
> > > For i = sblock To fblock
> > > v(j) = i
> > > j = j + 1
> > > Next i
> > >
> > > '****Read the Numbers on the Test Numbers Sheet********
> > > Set ws1 = Worksheets("Test Numbers")
> > > '******************************************************
> > >
> > > '****Write the Missed and Duplicated Number on the Missing and Duplicated
> > > Numbers Sheet********
> > > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > > '**********************************************************************************************
> > >
> > > With ws1
> > > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > > Set rng = .Range("a1:a" & lastrow)
> > > End With
> > >
> > > n1 = 2
> > > n2 = 2
> > > For i = LBound(v) To UBound(v)
> > > If IsError(Application.Match(v(i), rng, 0)) Then
> > > ws2.Cells(n1, 1) = v(i)
> > > n1 = n1 + 1
> > > Else
> > > If Application.CountIf(rng, v(i)) > 1 Then
> > > ws2.Cells(n2, 2) = v(i)
> > > n2 = n2 + 1
> > > End If
> > > End If
> > > Next i
> > > End Sub
> > >
> > > ‘****END PROGRAM****************************
> > >
> > >
> > >
> > >
> > >
> > >
> > >
> > >

Toppers;
This is the statement that show me the error;
ReDim v(fblock - sblock + 1)
Besides, how do I have to type the range?

Thanks.
Maperalia

"Toppers" wrote:

> Hi,
> Which statement gives the error? If you are not sure, go into the
> code and single shot through it, using F8 key.
>
> I have just re-tested and it works OK for me, given my understanding of your
> data. I tried a test with a range of 2a,7 i.e. mixed, and this also worked OK.
>
> If you still have problems, post a sample w/book
> ([email protected])
>
> HTH
>
> "maperalia" wrote:
>
> > Toppers;
> > Thanks for the quick response. I ran the program but when it asked me for
> > the range I typed 1a,2a,3a and then I got the following error message:
> >
> > RUN TIME ERROR"13"
> > TYPE MISMATCH
> >
> > Could you please tell me what I am doing wrong?
> >
> > Thanks.
> > Maperalia
> >
> > "Toppers" wrote:
> >
> > > Try this:
> > >
> > > Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
> > > if non-contiguous ("," is used as delimiter)
> > > Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)
> > >
> > >
> > > HTH
> > >
> > >
> > > Sub FindMissingAndDuplicates()
> > >
> > > Dim ws1 As Worksheet
> > > Dim ws2 As Worksheet
> > > Dim v()
> > > Dim missing() As Long
> > > Dim i As Long
> > > Dim lastrow As Long
> > > Dim x As Variant
> > > Dim rngStr As String
> > >
> > >
> > > '*****Find the Minimum and Maximum Number*********
> > > rngStr = Application.InputBox("Enter Range")
> > > '*************************************************
> > > n = InStr(1, rngStr, "-", vbTextCompare)
> > > If n <> 0 Then
> > > x = Split(rngStr, "-")
> > > sblock = x(0)
> > > fblock = x(1)
> > > ReDim v(fblock - sblock + 1)
> > >
> > > j = 0
> > > For i = sblock To fblock
> > > v(j) = i
> > > j = j + 1
> > > Next i
> > > Else
> > > x = Split(rngStr, ",")
> > > sblock = LBound(x)
> > > fblock = UBound(x)
> > > ReDim v(fblock - sblock + 1)
> > >
> > > j = 0
> > > For i = sblock To fblock
> > > If IsNumeric(x(i)) Then
> > > v(j) = CInt(x(i))
> > > Else
> > > v(j) = x(i)
> > > End If
> > > j = j + 1
> > > Next i
> > > End If
> > >
> > > '****Read the Numbers on the Test Numbers Sheet********
> > > Set ws1 = Worksheets("Test Numbers")
> > > '******************************************************
> > >
> > > '****Write the Missed and Duplicated Number on the Missing and
> > > DuplicatedNumbers Sheet********
> > > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > > '**********************************************************************************************
> > >
> > > With ws1
> > > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > > Set rng = .Range("a1:a" & lastrow)
> > > End With
> > >
> > > n1 = 2
> > > n2 = 2
> > > For i = LBound(v) To UBound(v)
> > > If IsError(Application.Match(v(i), rng, 0)) Then
> > > ws2.Cells(n1, 1) = v(i)
> > > n1 = n1 + 1
> > > Else
> > > If Application.CountIf(rng, v(i)) > 1 Then
> > > ws2.Cells(n2, 2) = v(i)
> > > n2 = n2 + 1
> > > End If
> > > End If
> > > Next i
> > > End Sub
> > >
> > >
> > > "maperalia" wrote:
> > >
> > > > I have a program that finds the missed and duplicated numbers (see below).
> > > > The program runs perfectly with numbers only, however, I want to make it run
> > > > with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> > > > program tell that 2a is duplicated and 2b is missed.
> > > > Could you please tell me if this is possible to do?
> > > > Thanks in advance.
> > > >
> > > > Maperalia
> > > >
> > > > ‘****START PROGRAM****************************
> > > > Sub FindMissingAndDuplicates()
> > > >
> > > > Dim ws1 As Worksheet
> > > > Dim ws2 As Worksheet
> > > > Dim v() As Long
> > > > Dim missing() As Long
> > > > Dim i As Long
> > > > Dim lastrow As Long
> > > >
> > > >
> > > > '*****Find the Minimum and Maximum Number*********
> > > > sblock = Application.InputBox("Enter block start")
> > > > fblock = Application.InputBox("Enter block end")
> > > > '*************************************************
> > > >
> > > > ReDim v(fblock - sblock + 1)
> > > >
> > > > j = 0
> > > > For i = sblock To fblock
> > > > v(j) = i
> > > > j = j + 1
> > > > Next i
> > > >
> > > > '****Read the Numbers on the Test Numbers Sheet********
> > > > Set ws1 = Worksheets("Test Numbers")
> > > > '******************************************************
> > > >
> > > > '****Write the Missed and Duplicated Number on the Missing and Duplicated
> > > > Numbers Sheet********
> > > > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > > > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > > > '**********************************************************************************************
> > > >
> > > > With ws1
> > > > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > > > Set rng = .Range("a1:a" & lastrow)
> > > > End With
> > > >
> > > > n1 = 2
> > > > n2 = 2
> > > > For i = LBound(v) To UBound(v)
> > > > If IsError(Application.Match(v(i), rng, 0)) Then
> > > > ws2.Cells(n1, 1) = v(i)
> > > > n1 = n1 + 1
> > > > Else
> > > > If Application.CountIf(rng, v(i)) > 1 Then
> > > > ws2.Cells(n2, 2) = v(i)
> > > > n2 = n2 + 1
> > > > End If
> > > > End If
> > > > Next i
> > > > End Sub
> > > >
> > > > ‘****END PROGRAM****************************
> > > >
> > > >
> > > >
> > > >
> > > >
> > > >
> > > >
> > > >

For a range of numbers, say 1 to 20, type:

1-20

For aphanumberic data type:

1a,2a,2b,3c in a single string (there must be a "," between each data item)

You could also type:

1,4,7,2a,2b

All these work OK for me.

"Toppers" wrote:

> Try this:
>
> Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
> if non-contiguous ("," is used as delimiter)
> Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)
>
>
> HTH
>
>
> Sub FindMissingAndDuplicates()
>
> Dim ws1 As Worksheet
> Dim ws2 As Worksheet
> Dim v()
> Dim missing() As Long
> Dim i As Long
> Dim lastrow As Long
> Dim x As Variant
> Dim rngStr As String
>
>
> '*****Find the Minimum and Maximum Number*********
> rngStr = Application.InputBox("Enter Range")
> '*************************************************
> n = InStr(1, rngStr, "-", vbTextCompare)
> If n <> 0 Then
> x = Split(rngStr, "-")
> sblock = x(0)
> fblock = x(1)
> ReDim v(fblock - sblock + 1)
>
> j = 0
> For i = sblock To fblock
> v(j) = i
> j = j + 1
> Next i
> Else
> x = Split(rngStr, ",")
> sblock = LBound(x)
> fblock = UBound(x)
> ReDim v(fblock - sblock + 1)
>
> j = 0
> For i = sblock To fblock
> If IsNumeric(x(i)) Then
> v(j) = CInt(x(i))
> Else
> v(j) = x(i)
> End If
> j = j + 1
> Next i
> End If
>
> '****Read the Numbers on the Test Numbers Sheet********
> Set ws1 = Worksheets("Test Numbers")
> '******************************************************
>
> '****Write the Missed and Duplicated Number on the Missing and
> DuplicatedNumbers Sheet********
> Set ws2 = Worksheets("Missing and Duplicated Numbers")
> ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> '**********************************************************************************************
>
> With ws1
> lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> Set rng = .Range("a1:a" & lastrow)
> End With
>
> n1 = 2
> n2 = 2
> For i = LBound(v) To UBound(v)
> If IsError(Application.Match(v(i), rng, 0)) Then
> ws2.Cells(n1, 1) = v(i)
> n1 = n1 + 1
> Else
> If Application.CountIf(rng, v(i)) > 1 Then
> ws2.Cells(n2, 2) = v(i)
> n2 = n2 + 1
> End If
> End If
> Next i
> End Sub
>
>
> "maperalia" wrote:
>
> > I have a program that finds the missed and duplicated numbers (see below).
> > The program runs perfectly with numbers only, however, I want to make it run
> > with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> > program tell that 2a is duplicated and 2b is missed.
> > Could you please tell me if this is possible to do?
> > Thanks in advance.
> >
> > Maperalia
> >
> > ‘****START PROGRAM****************************
> > Sub FindMissingAndDuplicates()
> >
> > Dim ws1 As Worksheet
> > Dim ws2 As Worksheet
> > Dim v() As Long
> > Dim missing() As Long
> > Dim i As Long
> > Dim lastrow As Long
> >
> >
> > '*****Find the Minimum and Maximum Number*********
> > sblock = Application.InputBox("Enter block start")
> > fblock = Application.InputBox("Enter block end")
> > '*************************************************
> >
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > v(j) = i
> > j = j + 1
> > Next i
> >
> > '****Read the Numbers on the Test Numbers Sheet********
> > Set ws1 = Worksheets("Test Numbers")
> > '******************************************************
> >
> > '****Write the Missed and Duplicated Number on the Missing and Duplicated
> > Numbers Sheet********
> > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > '**********************************************************************************************
> >
> > With ws1
> > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > Set rng = .Range("a1:a" & lastrow)
> > End With
> >
> > n1 = 2
> > n2 = 2
> > For i = LBound(v) To UBound(v)
> > If IsError(Application.Match(v(i), rng, 0)) Then
> > ws2.Cells(n1, 1) = v(i)
> > n1 = n1 + 1
> > Else
> > If Application.CountIf(rng, v(i)) > 1 Then
> > ws2.Cells(n2, 2) = v(i)
> > n2 = n2 + 1
> > End If
> > End If
> > Next i
> > End Sub
> >
> > ‘****END PROGRAM****************************
> >
> >
> >
> >
> >
> >
> >
> >

Topper;
It is working perfectly!!!!!!!!
Thanks very much.
One last questions it is possible to add a statement to get the quantity of
numbers that have been repeted. For example; if I have the number 5 repeted
100 times, and the the number 8 repeted 250 times. I would like to see next
to its row the number 100 and 250 respectively.

Thnaks in advance.

Maperalia

"Toppers" wrote:

> For a range of numbers, say 1 to 20, type:
>
> 1-20
>
> For aphanumberic data type:
>
> 1a,2a,2b,3c in a single string (there must be a "," between each data item)
>
> You could also type:
>
> 1,4,7,2a,2b
>
> All these work OK for me.
>
> "Toppers" wrote:
>
> > Try this:
> >
> > Numeric ranges are entered as 1-10 ("-" must be present) or 1,2,3,5,6,8,10
> > if non-contiguous ("," is used as delimiter)
> > Alphanumeric are entered as 1a,2a,2b,3c ("," is used as delimiter)
> >
> >
> > HTH
> >
> >
> > Sub FindMissingAndDuplicates()
> >
> > Dim ws1 As Worksheet
> > Dim ws2 As Worksheet
> > Dim v()
> > Dim missing() As Long
> > Dim i As Long
> > Dim lastrow As Long
> > Dim x As Variant
> > Dim rngStr As String
> >
> >
> > '*****Find the Minimum and Maximum Number*********
> > rngStr = Application.InputBox("Enter Range")
> > '*************************************************
> > n = InStr(1, rngStr, "-", vbTextCompare)
> > If n <> 0 Then
> > x = Split(rngStr, "-")
> > sblock = x(0)
> > fblock = x(1)
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > v(j) = i
> > j = j + 1
> > Next i
> > Else
> > x = Split(rngStr, ",")
> > sblock = LBound(x)
> > fblock = UBound(x)
> > ReDim v(fblock - sblock + 1)
> >
> > j = 0
> > For i = sblock To fblock
> > If IsNumeric(x(i)) Then
> > v(j) = CInt(x(i))
> > Else
> > v(j) = x(i)
> > End If
> > j = j + 1
> > Next i
> > End If
> >
> > '****Read the Numbers on the Test Numbers Sheet********
> > Set ws1 = Worksheets("Test Numbers")
> > '******************************************************
> >
> > '****Write the Missed and Duplicated Number on the Missing and
> > DuplicatedNumbers Sheet********
> > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > '**********************************************************************************************
> >
> > With ws1
> > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > Set rng = .Range("a1:a" & lastrow)
> > End With
> >
> > n1 = 2
> > n2 = 2
> > For i = LBound(v) To UBound(v)
> > If IsError(Application.Match(v(i), rng, 0)) Then
> > ws2.Cells(n1, 1) = v(i)
> > n1 = n1 + 1
> > Else
> > If Application.CountIf(rng, v(i)) > 1 Then
> > ws2.Cells(n2, 2) = v(i)
> > n2 = n2 + 1
> > End If
> > End If
> > Next i
> > End Sub
> >
> >
> > "maperalia" wrote:
> >
> > > I have a program that finds the missed and duplicated numbers (see below).
> > > The program runs perfectly with numbers only, however, I want to make it run
> > > with letters also. For example, I want to type 1a, 1b, 2a, 2a, 2c and let the
> > > program tell that 2a is duplicated and 2b is missed.
> > > Could you please tell me if this is possible to do?
> > > Thanks in advance.
> > >
> > > Maperalia
> > >
> > > ‘****START PROGRAM****************************
> > > Sub FindMissingAndDuplicates()
> > >
> > > Dim ws1 As Worksheet
> > > Dim ws2 As Worksheet
> > > Dim v() As Long
> > > Dim missing() As Long
> > > Dim i As Long
> > > Dim lastrow As Long
> > >
> > >
> > > '*****Find the Minimum and Maximum Number*********
> > > sblock = Application.InputBox("Enter block start")
> > > fblock = Application.InputBox("Enter block end")
> > > '*************************************************
> > >
> > > ReDim v(fblock - sblock + 1)
> > >
> > > j = 0
> > > For i = sblock To fblock
> > > v(j) = i
> > > j = j + 1
> > > Next i
> > >
> > > '****Read the Numbers on the Test Numbers Sheet********
> > > Set ws1 = Worksheets("Test Numbers")
> > > '******************************************************
> > >
> > > '****Write the Missed and Duplicated Number on the Missing and Duplicated
> > > Numbers Sheet********
> > > Set ws2 = Worksheets("Missing and Duplicated Numbers")
> > > ws2.Range("a1:b1") = Array("Missing", "Duplicated")
> > > '**********************************************************************************************
> > >
> > > With ws1
> > > lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
> > > Set rng = .Range("a1:a" & lastrow)
> > > End With
> > >
> > > n1 = 2
> > > n2 = 2
> > > For i = LBound(v) To UBound(v)
> > > If IsError(Application.Match(v(i), rng, 0)) Then
> > > ws2.Cells(n1, 1) = v(i)
> > > n1 = n1 + 1
> > > Else
> > > If Application.CountIf(rng, v(i)) > 1 Then
> > > ws2.Cells(n2, 2) = v(i)
> > > n2 = n2 + 1
> > > End If
> > > End If
> > > Next i
> > > End Sub
> > >
> > > ‘****END PROGRAM****************************
> > >
> > >
> > >
> > >
> > >
> > >
> > >
> > >