1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Insert rows with formatting based on a cell value - automatically

Discussion in 'VBA Macros' started by Ellonash, Nov 7, 2018.

  1. Ellonash

    Ellonash New Member

    Messages:
    2
    Good Day,

    I need to create a sheet, that when a cell is a completed with a specific number, that number of rows (specified in the cell) would automatically be inserted (without me having to run the macro. And when it inserts rows, the formatting of the line above should be duplicated / copied. Please see the macro below and advise if you can modify and assist me please?

    The current macro is only inserting the rows, no formatting or automation in inserting the rows - Please see below - I've attached the Excel Workbook as well

    Code (vb):
    Sub Insert()
    'UpdatebyExtendoffice20170926
    Dim xRg As Range
    Dim xAddress As String
    Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Select a range to use(A1:H1):", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    xLastRow = xRg(1).End(xlDown).Row
    xFstRow = xRg.Row
    xCol = xRg.Column
    xCount = xRg.Count
    Set xRg = xRg(1)
    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
    xRg.Resize(xCount, 1).Select
    Application.ScreenUpdating = True
    End Sub
    Your help would be much appreciated

    Thank you

    Attached Files:

    Last edited by a moderator: Nov 7, 2018
  2. Hui

    Hui Excel Ninja Staff Member

    Messages:
    11,639
    Try this

    Code (vb):

    Sub Insert()
      Dim xRg As Range
      Dim xAddress As String
       
      On Error GoTo Finito
      xAddress = ActiveWindow.RangeSelection.Address
      Set xRg = Application.InputBox("Select a range to use(A1:H1):", "Insert Formatted Rows", xAddress, , , , , 8)
      If xRg Is Nothing Then Exit Sub
       
      Application.ScreenUpdating = False
       
      Dim iRng As Range
      Set iRng = xRg.Offset(1, 0).Resize(xRg.Value, 5)
       
      'Insert Rows
     iRng.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       
      'Copy source row format
     Range(xRg, xRg.Offset(0, 4)).Copy
       
      'Paste format to new rows
     iRng.Offset(-xRg, 0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
       
      'Cleanup
    Finito:
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
    End Sub
  3. Ellonash

    Ellonash New Member

    Messages:
    2
    Thank you so much! It's working perfectly!! :)

Share This Page