Visual Basic code help needed

[Rick]

I use the following code to determine which numbers are
missing from a column of data I paste in. Some of the
numbers on the list I enter have a * character in front of
them, which crashes the routine below unless I go into the
original list and manually delete all the numbers with a
*.
Can someone help me figure out a bit of code that I could
add to the routine below that would allow the * numbers to
be ignored from the list? I also don't want the * numbers
to be counted in the missing number list.
For example:
My original list of numbers is the following:
6000
6002
6*003
6*004
6005
6007
6*008
6009
and so forth...

After I paste this list in...the resulting missing numbers
list would give me:
6001
6003
6004
6006
6008
....
Unfortunately this doesn't work until I manually remove
the * numbers. Any help with the additional code needed
would be terrific.

-Rick
--------------------

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

k = 1
prev = 5999 ' one less than beginning, here 6000
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 6299
If prev < 6299 Then
V = Evaluate("Row(" & prev + 1 & ":6299)")
n = 6299 - prev
Cells(k, "C").Resize(n, 1) = V
End If

End Sub

 

[Michael Tomasura]

If you want to remove the * use this code


For y = 1 To 10
For x = 1 To Len(Range("A" & y))
If Mid(Range("A" & y), x, 1) = "*" Then
Range("A" & y) = Left(Range("A" & y), x - 1) & Right(Range("A" &
y), Len(Range("A" & y)) - x)
End If
Next x
Next y

Michael Tomasura

 

[Guest]

Thanks - but how would I incorporate this into the already
existing code below? Note that the code has a specific
range of numbers between 6000-6299. When I paste a batch
of numbers in and run the macro, it'll spit back the
numbers that aren't on the list.

-Rick

 

[Myrna Larson]

How about a 1-liner using the Replace method of the Range object for this? It
should be lots faster.

Dim Rng As Range
Set Rng = Range("A1").Resize(10, 1) 'modify to suit
Rng.Replace What:="*", Replacement:="", LookAt:=xlPart

 

[Michael Tomasura]

y would be the rows
change the column "A" to what ever column you have the numbers in.
this will remove any * in the numbers between A:6000 to A:6299 the way it is
setup now.
I would run this before you run your other code

For y = 6000 To 6299
For x = 1 To Len(Range("A" & y))
If Mid(Range("A" & y), x, 1) = "*" Then
Range("A" & y) = Left(Range("A" & y), x - 1) & Right(Range("A"
& y), Len(Range("A" & y)) - x)
End If
Next x
Next y

 

[Myrna Larson]

If your goal is to display all numbers that are missing in the range 6000
through 6299, then I would write it this way.

I haven't tested it, but I think the code will fail if a number is duplicated.
Is that a possibility? If so, a different approach will be needed.

Option Explicit

Sub DisplayMissing()
Dim v As Variant 'array containing values in column A
Dim vv As Variant 'an individual value from the array
Dim Missing() As Double 'numbers that are missing
Dim ThisRow As Long 'row we're looking at now
Dim PrevRow As Long 'previous row
Dim m As Long 'pointer to list of missing numbers
Dim TargetNumber As Long 'number we're looking for
Dim N As Long 'cell value converted to a number

Dim Low As Long
Dim High As Long

Low = 6000
High = 6299

ReDim Missing(1 To High - Low + 1) 'allow room for all missing

With ActiveSheet
v = Intersect(.UsedRange, .Columns(1)).Value
End With

m = 0
TargetNumber = Low
ThisRow = 1
PrevRow = 0
For TargetNumber = Low To High
'get the number in the new row if we've moved to a new row
If ThisRow <> PrevRow Then
vv = v(ThisRow, 1)
PrevRow = ThisRow

'get rid of the asterisk
If InStr(vv, "*") Then
vv = Replace(vv, "*", "")
End If

'convert to a number in variable N
If IsNumeric(vv) Then
N = CLng(vv)
Else
N = Low - 1
End If
End If

If N = TargetNumber Then
'a match, so go on to the next row
ThisRow = ThisRow + 1
Else
'a mismatch: save it, stay on the same row
m = m + 1
Missing(m) = TargetNumber
End If
Next TargetNumber

ActiveSheet.Columns(3).ClearContents
If m = 0 Then
MsgBox "No numbers are missing!", vbOKOnly
Else
ActiveSheet.Cells(1, 3).Resize(m, 1).Value = _
Application.Transpose(Missing())
End If
End Sub

 

[Rick]

I tried this, and it works initially. However, once it
hits a * number, it just lists every whole number as a
missing number from that point on. Essentially, I just
want all * numbers to be ignored on the list.
So if I have:
6000
6001
60*02
60*03
6003

It should detect that 6002 is a missing number.

 

[Rick]

I tried running this on its own and it didn't do anything
(although it didn't crash).
Running it with the other code present, I get a type
mismatch error on the following line:
V = Evaluate("Row(" & prev + 1 & ":" & C - 1 & ")")

Try running the code with the following numbers in column
A and let me know if you get the same problem:
6097
6098
6099
60*06
60*26
60*28
6100
6101
6102

 

[Myrna Larson]

However, once it hits a * number, it just lists every whole number as a

missing number from that point on.

I tested the code before posting it, and it didn't do that for me. Evidently
the sample data I used didn't match what you have The code removes the
asterisk from the number, so that 60*02 becomes 6002, 60*03 becomes 6003,
etc. With the data you show below, there would be a duplicate -- 6003 would
be listed twice. The macro I wrote won't handle that.

If you want to ignore the entries containing an asterisk, here's a much
simpler routine that uses the MATCH function to search the range for each
number in turn (6000, then 6001, 6002, 6003, up to 6299). If a number isn't
found, it's added to the list of missing numbers.

This approach won't detect numbers that are listed more than once. If you
want to do that, you could use COUNTIF instead of MATCH. (If the result is
0, the number is missing; if it's > 1, the number is duplicated.)

It won't tell you that the numbers are out of order, if that is a concern.


Sub DisplayMissing2()
Dim Rng As Range
Dim Missing() As Double
Dim m As Long
Dim TargetNumber As Long

Dim Low As Long
Dim High As Long

Low = 6000
High = 6299

ReDim Missing(1 To High - Low + 1) 'allow room for all missing

With ActiveSheet
Set Rng = Intersect(.UsedRange, .Columns(1))
End With

m = 0
For TargetNumber = Low To High
If IsError(Application.Match(TargetNumber, Rng, 0)) Then
m = m + 1
Missing(m) = TargetNumber
End If
Next TargetNumber

ActiveSheet.Columns(3).ClearContents
If m = 0 Then
MsgBox "No numbers are missing!", vbOKOnly
Else
ActiveSheet.Cells(1, 3).Resize(m, 1).Value = _
Application.Transpose(Missing())
End If
End Sub