Solved: Need a msgbox to report to me the missing record number

In the list below you'll see record number 18423 is missing.(in reality that is not the number that is missing)
I do know though for sure that I have a record number missing and I know that a user almost certainly must have deleted a row, or worse yet possibly some cells, when they should have only voided it or made edits to it.

I need a quick way to report to me in a msgbox or similar, what record number is missing. So that I can correct any possible mismatching data. There are over 18,000 rows --
-- I'm under a bit of a time crunch to spot this, as the app., is down with a user waiting until I can repair and certify that the records are not corrupted... I will be very appreciative if you can lend me a hand asap.
(Col AA)---(Col AB) is empty
18438
18437
18436
18435
18434
18433
18432
18431
18430
18429
18428
18427
18426
18425
18424----
18422----
18421
18420
18419
18418
18417

This is quick n dirty, if your entries are numbers then this will work, it assumes that your numbers are in column AA and are supposed to be consecutive[vba]Sub count_em()
Dim rng As Range, MyCell As Range, msg As String
Set rng = Range("AA3:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
If MyCell.Value <> MyCell.Offset(-1, 0).Value + 1 Then
msg = msg & vbLf & MyCell.Address & " value " & MyCell.Offset(-1, 0).Value + 1 & " is missing"
End If
Next MyCell
MsgBox "Missing entries found at or near:" & vbLf & msg
End Sub[/vba]

[VBA]
Sub FindMissingNum()

Dim LastRow As Long, i As Long, j As Long, diff As Long
Dim temp, missing

LastRow = Cells(Rows.Count, "AA").End(xlUp).Row

For i = 2 To LastRow - 1 'assuming Row1 houses headers
diff = Cells(i, "AA").Value - Cells(i + 1, "AA").Value 'assuming numbers are sorted descending
If diff > 1 Then 'assuming numbers increment by 1
For j = 1 To diff - 1 'in case there are more than one missing numbers
temp = temp & (Cells(i + 1, "AA").Value + j) & ", "
Next
End If
Next

temp = Left(temp, Len(temp) - 2)
missing = Split(temp, ", ")

Range("AF1").Resize(UBound(missing) + 1, 1) = Application.Transpose(missing)

End Sub
[/VBA]

I'd just add a formula in AB2 list =AA2-AA1, fill down, and then Find a '2'

Paul

Quote:

---

Originally Posted by Paul_Hossler

I'd just add a formula in AB2 list =AA2-AA1, fill down, and then Find a '2'

Paul

---

Thats fair enough but he'd need to use the find all function to find the 2's in 18000 rows :)

Quote:

---

Originally Posted by mancubus

[vba]
Sub FindMissingNum()

Dim LastRow As Long, i As Long, j As Long, diff As Long
Dim temp, missing

LastRow = Cells(Rows.Count, "AA").End(xlUp).Row

For i = 2 To LastRow - 1 'assuming Row1 houses headers
diff = Cells(i, "AA").Value - Cells(i + 1, "AA").Value 'assuming numbers are sorted descending
If diff > 1 Then 'assuming numbers increment by 1
For j = 1 To diff - 1 'in case there are more than one missing numbers
temp = temp & (Cells(i + 1, "AA").Value + j) & ", "
Next
End If
Next

temp = Left(temp, Len(temp) - 2)
missing = Split(temp, ", ")

Range("AF1").Resize(UBound(missing) + 1, 1) = Application.Transpose(missing)

End Sub
[/vba]

---

I think you'll need to change this[VBA]diff = Cells(i, "AA").Value - Cells(i + 1, "AA").Value [/VBA]for this[VBA]diff = Cells(i + 1, "AA").Value - Cells(i, "AA").Value[/VBA]otherwise your number will always be a negative so your code will not produce and finds :)

HI mancubus and simon

Even though they are numbers and the cells are formatted as numbers, I get a type mismatch error with both of your routines. - I tried prefixing all the values with Val(....value), and that avoids the error and gets results from mancubus code, except that the results are incorrect. - And with simons recommended change, I get no results.

simon, with your routine, as I said above, I was getting a type mismatch error, so I added Val(...Value) in the appropriate places. Now I get what looks to be every row listed in the msgbox(I'm not sure if you remembered, that my numbers get smaller from top to bottom.


I got out of my jam awhile before all of you posted, by using a formula similar to Pauls

Thank you all


I'll respond further tomorrow, as I'm too tired right now.

A sample workbook of your actual data would be good, both my code and Mancubus' code worked fine for me (with a little change i indicated :)) so it must be your data or how it's presented.

EDIT: added sample workbook, although mancubus' code gives different results and at this time are incorrect, i'll take a look when i have time.

As a quick fix to Mancubus' code posted in that sample workbook (and because i was too lazy to look at it properly, change this[VBA]temp = temp & (Cells(i + 1, "A").Value + j)[/VBA]to this[VBA]temp = temp & (Cells(i + 1, "A").Value + j) - 2[/VBA]

Hi Simon

Thanks for your efforts.

Problem is my numbers are descending, as I gave in my sample batch

yours are ascending

In hind sight, it would have been easier to follow my request if I had written the word descending.. Sorry about that.

I attached a new sample workbook that has my actual numbers, with two of them missing.

Edit: attached theworkbook again, as the site was having dificulty uploading the first time I tried

I think you must have messed up when attaching a workbook as it's not there, change my code in that example i posted to this[vba]Sub Simon()
Dim rng As Range, MyCell As Range, msg As String
Set rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
For Each MyCell In rng
If MyCell.Value <> MyCell.Offset(-1, 0).Value - 1 Then
msg = msg & vbLf & MyCell.Address & " value " & MyCell.Offset(-1, 0).Value - 1 & " is missing"
End If
Next MyCell
MsgBox "Missing entries found at or near:" & vbLf & msg
End Sub[/vba]and then change the entries to be your descending numbers, it should work fine :)

That works great now.

Thanks a lot Simon :bow:

Final version workbook attached.

My apologies for not reading this thread right to Mancubus, your code does work fine without any issues for descending numbers :)

Frank, not solved!!! the code you need is this as the other gives wrong results[VBA]Sub Simon()
Dim rng As Range, MyCell As Range, msg As String
Set rng = Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)
msg = ""
For Each MyCell In rng
If MyCell.Value <> MyCell.Offset(1, 0).Value + 1 Then
msg = msg & vbLf & MyCell.Address & " value " & MyCell.Offset(1, 0).Value + 1 & " is missing"
End If
Next MyCell
MsgBox "Missing entries found at or near:" & vbLf & msg
End Sub[/VBA]

awe ok.. I guess my headache caused me to see the results incorretly as I was so sure they were correct

Thanks for updating it..

I'll have to try your latest version in a few hours, as I'm falling over and thump, thump, thump, is pulsating on my head..

Thanks again

well its 01:45 here and i kinda feel the same :)

When you run the new code you will find that you have 3 ommissions :)

Quote:

---

Originally Posted by Simon Lloyd

Thats fair enough but he'd need to use the find all function to find the 2's in 18000 rows :)

---

Quote:

---

I do know though for sure that I have a record number missing and I know that a user almost certainly must have deleted a row,

---

I read the OP's #1 as only one record was missing, and was looking for a quick and dirty way to find it

From the more involved macros, maybe I misunderstood

Paul

HI Simon,

After taking a nap, I'm seeing a few less double images with my blurry eyes now, and my head is pounding a lot less, so I'm fairly sure now that I am correct this time in saying that you have tackled the challenge nicely.

Thank you Sir
---------------------------------------------------
Paul,

You are correct. Originally there was only one number missing, and I used a method similar to yours to spot it. - What has transpire since then, has been mostly for interest sake, but also so that I'll have it just incase the situation arises again.

mancubus

Yours is giving me a runtime error 5, invalid procedure call, or arguement on this line:
temp = Left(temp, Len(temp) - 2)

Thank you much for your time

Here's a revised version of Paul's idea. This code marks "ERR" in column B where a value is missed.
[VBA]Sub PaulsIdea()
Application.ScreenUpdating = False
With Range("B3:B" & Range("A" & Rows.Count).End(xlUp).Row)
.FormulaR1C1 = "=IF(R[-1]C[-1] - 1<>RC[-1]," & Chr(34) & "ERR" & _
Chr(34) & "," & Chr(34) & Chr(34) & ")"
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub[/VBA]