M
maperalia
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****************************
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****************************