Sub add_row()
Dim datalastrow, x, y As Long
Dim this_row_text, prev_row_text As String
Dim xCell As Object
Application.ScreenUpdating = False
datalastrow = ActiveSheet.Cells(Rows.count, 5).End(xlUp).Row 'find the last row of data in Col 5 (E)
For x = datalastrow To 3 Step -1
this_row_text = ActiveSheet.Range(Cells(x, 5), Cells(x, 5))
prev_row_text = ActiveSheet.Range(Cells(x - 1, 5), Cells(x - 1, 5))
nbr_to_insert = CLng(this_row_text) - CLng(prev_row_text)
If nbr_to_insert > 1 Then
For y = 2 To nbr_to_insert
ActiveSheet.Range(Cells(x, 5), Cells(x, 5)).EntireRow.Insert ' insert blank row
'************** Section of code can be removed if you do not want to Insert missing numbers automatically ************************
For Each xCell In ActiveSheet.Range(Cells(x, 5), Cells(x, 5))
xCell.NumberFormat = "@" 'these 2 rows insert the missing numbers as Text
xCell.Value = CStr(CLng(this_row_text) - (y - 1)) 'these 2 rows insert the missing numbers as text
xCell.Font.Color = vbRed ' this row changes the font color to RED in order to highlight the inserted Rows more quickly
Next xCell
'***********************************************************************************************************************************
Next y
End If
Next x
Application.ScreenUpdating = False
End Sub