Inserting rows for missing numbers in a column using VBA code

[ChetBelfast]

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.

 

[RobP]

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

 

[ChetBelfast]

Thanks for catching that, Rob. It is the column under the purple cell that says Items removed.

 

[ChetBelfast]

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.

 

[RobP]

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

 

[RobP]

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.

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

 

[HaHoBe]

Hi ChetBelfast,

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

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

 

[HaHoBe]

Hi ChetBelfast,

adding the missing numbers at the end:

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

 

[RobP]

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.

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

 

[ChetBelfast]

Hi ChetBelfast,

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

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.