I just noticed that you said the number is a date. If possible, if you could attached a spreadsheet for testing, it would help.
possible alteration to
Dim First_Num As Integer
Dim Second_Num As Integer
'Change the above to the below
Dim First_Num As Date
Dim Second_Num Date
Could work if you experince problems, but I haven't tested it.
Very little testing was done with this code on a spreadsheat created using your example.
I think it will work just fine. Try this.
NOTE:This code assumes the following.
All of you numbers are in column A
Colum A contains no blank cells before the end of the sheet
You have a header on your worksheet
Option Explicit
Sub Complete_Missing_Data()
Dim First_Num As Integer
Dim Second_Num As Integer
Dim i As Integer
Dim FinalRow As Long
FinalRow = Range("A65536").End(xlUp).Row
For i = FinalRow To 2 Step -1
First_Num = Range("A" & i).Value
Second_Num = Range("A" & i - 1).Value
If First_Num - 1 <> Second_Num Then
Rows(i).Insert
Range("A" & i).Value = First_Num - 1
FinalRow = FinalRow + 1
i = i + 1
End If
Next i
End Sub
to make this work. open your sheet click on tools, option, visual basic editor. right click on thisworkbook and select insert modual. Past the code in there. press F5 to run the code on the sheet that you opened.
if you want to run this on a workbook with multiple sheets, use the following.
Option Explicit
Sub Complete_Missing_Data()
Dim First_Num As Integer
Dim Second_Num As Integer
Dim i As Integer
Dim WrkSht As Worksheet
For Each WrkSht In Worksheets
WrkSht.Select
Dim FinalRow As Long
FinalRow = Range("A65536").End(xlUp).Row
For i = FinalRow To 2 Step -1
First_Num = Range("A" & i).Value
Second_Num = Range("A" & i - 1).Value
If First_Num - 1 = Second_Num Then
'Do nothing
End If
If First_Num - 1 <> Second_Num Then
Rows(i).Insert
Range("A" & i).Value = First_Num - 1
FinalRow = FinalRow + 1
i = i + 1
End If
Next i
Next WrkSht
End Sub
IMPORTANT NOTE: THIS CODE MIGHT ENCOUNTER PROBLEMS DEPENDING ON WHAT IS CONTAINED IN YOU HEADER. THIS WAS TESTED ON A SHEET WITH A BLANK LINE ON ROW 1.
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks