Inserting rows for missing numbers in a column using VBA code

ChetBelfast

New Member
Joined
Nov 10, 2022
Messages
4
Office Version
  1. 365
Platform
  1. Windows
I am trying to get the a row inserted for all of the missing numbers in column E. There are over 1000 rows and there are randomly some numbers now in there. Just getting a row inserted will allow me to copy in data from another file to this, but the missing numbers are getting me and I can't seem to get a code to work with this many columns.
 

Attachments

  • Picture1.png
    Picture1.png
    38.7 KB · Views: 30
Hi, Welcome to the forum

can you tell us which is Col E in your picture please, as its not clear ?

A little more clarity on where you want the row inserted would also help people here get you the right answer.

Rob
 
Upvote 0
Thanks for catching that, Rob. It is the column under the purple cell that says Items removed.
 
Upvote 0
Thanks for catching that, Rob. It is the column under the purple cell that says Items removed.
Hi, Welcome to the forum

can you tell us which is Col E in your picture please, as its not clear ?

A little more clarity on where you want the row inserted would also help people here get you the right answer.

Rob
Also I need rows inserted where there is a missing sequential number in Column E. For example. There is not 9. There is randomly missing numbers throughout that town and there is over 1000 rows of data.
 
Upvote 0
Hi in Col E, I see you have data that looks like "text" trying to be numbers. eg. 01, 02, 03 - could you confirm what kind of data this actually is (eg. if it is Text, or if it is actually a "number" as usually if its a number, you don't get the zero before it, so typically, numbers would read 1,2,3,4, etc not 01,02,03.

thanks
Rob
 
Upvote 0
Hi, assuming the numbers in your Col E are text (as I asked above), *and* they are sequential, *and* the data starts in Row 2, this code might do what you want. Let me know how it goes.

VBA Code:
Sub add_row()

Dim datalastrow, x, y As Long
Dim this_row_text, prev_row_text As String

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 = CInt(this_row_text) - CInt(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
        Next y
       
    End If
 
Next x

End Sub
 
Upvote 0
Hi ChetBelfast,

working on the active sheet, adjust Column and starting Row for code to suit:

VBA Code:
Sub MrE1221863_1613E0E()

Dim lngCounter          As Long
Dim lngAdd              As Long

Const cstrCol           As String = "E"
Const clngStartData     As Long = 2

lngCounter = clngStartData + 1

Application.ScreenUpdating = False
Do While Cells(lngCounter, cstrCol).Value <> ""
  With Cells(lngCounter, cstrCol)
    If CLng(.Value) > .Offset(-1).Value + 1 Then
       lngAdd = .Value - .Offset(-1).Value - 1
      .EntireRow.Resize(lngAdd).Insert
      lngCounter = lngCounter + lngAdd
    End If
  End With
  lngCounter = lngCounter + 1
Loop
Application.ScreenUpdating = True

MsgBox "Done", vbExclamation, "MrE1221863"

End Sub

Ciao,
Holger
 
Upvote 0
Solution
Hi ChetBelfast,

adding the missing numbers at the end:

VBA Code:
Sub MrE1221863_1613E0E_V2()

Dim lngCounter          As Long
Dim lngAdd              As Long

Const cstrCol           As String = "E"
Const clngStartData     As Long = 2

lngCounter = clngStartData + 1

Application.ScreenUpdating = False
Do While Cells(lngCounter, cstrCol).Value <> ""
  With Cells(lngCounter, cstrCol)
    If CLng(.Value) > .Offset(-1).Value + 1 Then
       lngAdd = .Value - .Offset(-1).Value - 1
      .EntireRow.Resize(lngAdd).Insert
      lngCounter = lngCounter + lngAdd
    End If
  End With
  lngCounter = lngCounter + 1
Loop
Range(Cells(clngStartData, cstrCol), Cells(Rows.Count, cstrCol).End(xlUp)).DataSeries _
    Rowcol:=xlColumns, _
    Type:=xlLinear, _
    Date:=xlDay, _
    Step:=1, _
    Trend:=False
Application.ScreenUpdating = True

MsgBox "Done", vbExclamation, "MrE1221863"

End Sub

Ciao,
Holger
 
Upvote 0
Hi, indeed yes - as HaHoBe has offered, in case you want to add the numbers into your rows automatically, I've added a section of code also like thus:

What I realised though is that if you add them automatically, it might become more difficult to spot quickly where the rows have been inserted - so I have also changed the font color of them to RED in order to highlight quickly the ones added. Of course you can simply remove this color format, and / or this auto inserting code section between the asterisks as you see fit.

VBA Code:
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
 
Upvote 0
Hi ChetBelfast,

working on the active sheet, adjust Column and starting Row for code to suit:

VBA Code:
Sub MrE1221863_1613E0E()

Dim lngCounter          As Long
Dim lngAdd              As Long

Const cstrCol           As String = "E"
Const clngStartData     As Long = 2

lngCounter = clngStartData + 1

Application.ScreenUpdating = False
Do While Cells(lngCounter, cstrCol).Value <> ""
  With Cells(lngCounter, cstrCol)
    If CLng(.Value) > .Offset(-1).Value + 1 Then
       lngAdd = .Value - .Offset(-1).Value - 1
      .EntireRow.Resize(lngAdd).Insert
      lngCounter = lngCounter + lngAdd
    End If
  End With
  lngCounter = lngCounter + 1
Loop
Application.ScreenUpdating = True

MsgBox "Done", vbExclamation, "MrE1221863"

End Sub

Ciao,
Holger
This worked. Thank you very both. Actually both of them seem to work. So thanks.
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top