I am a newbie to VBA. I have a database of peptide sequences that I would like to add the different numbers of blank rows under the proteins' name so I could analyze the data in the next step. The number of blank rows I want to add are in column D, e.g. 73 blank rows for Solyc09g007080.3.1, as shown in this screenshot. I found a code to add specific numbers of blank rows under each row and I adjusted that code to be used with my list. It works, but it is only run for 2 protein names every time I run the code when I chose about 34,000 numbers in column D for the blank rows to be added. Could you tell me what is wrong with my code and how to fix it, please? Thank you very much, Nan

 Sub InsertSpecificNumberOfBlankRows()
 Dim xRg As Range
 Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long

 Set xRg = Selection
 If xRg Is Nothing Then Resume Next
     Application.ScreenUpdating = False
     xLastRow = xRg(1).End(xlDown).Row
     xFstRow = xRg.Row
     xCol = xRg.Column
     xCount = xRg.Count

     For I = xLastRow To xFstRow Step -1
         xNum = Cells(I, xCol)
         If IsNumeric(xNum) And xNum > 0 Then
             Rows(I   1).Resize(xNum).Insert
             xCount = xCount   xNum
         End If

     Next
     Application.ScreenUpdating = True

 End Sub

CodePudding user response：

Insert Empty Rows

Option Explicit

Sub InsertSpecificNumberOfBlankRows()

    If Not TypeOf Selection Is Range Then Exit Sub ' 'Selection' is not a range
    
    Dim srg As Range: Set srg = Selection.Columns(1)
    Dim ws As Worksheet: Set ws = srg.Worksheet
    
    Dim sLastRow As Long: sLastRow = srg.Cells(srg.Rows.Count).Row
    Dim sFirstRow As Long: sFirstRow = srg.Row
    Dim sCol As Long: sCol = srg.Column
    
    Application.ScreenUpdating = False

    Dim sValue As Variant
    Dim irCount As Long
    Dim r As Long
    
    For r = sLastRow To sFirstRow Step -1
         sValue = ws.Cells(r, sCol).Value
         If IsNumeric(sValue) Then
             If sValue >= 1 Then
                 ws.Rows(r   1).Resize(sValue).Insert _
                      xlShiftDown, xlFormatFromLeftOrAbove
                 irCount = irCount   sValue
             End If
         End If
    Next r
     
    Application.ScreenUpdating = True

    MsgBox "Inserted " & irCount & " rows.", vbInformation

End Sub