Excel VBA inserting rows and filling dynamic link

user_15418317 0
Viewed 75

I'm looking for some help, brand new to VBA. I'm trying to create a macro to take a list of linked cells, insert a number of new rows between each line, and autofill from above to drag and continue the dynamic link down from the worksheet each cell is linked to.

I started with some code from Kutools, and now trying to modify for my needs.

Help!

Sub fill()

'Attempting to create new rows at every interval and fill autofill from the existing cell above at this interval

Dim Rng As Range
Dim xInterval As Integer
Dim xRows As Integer
Dim xRowsCount As Integer
Dim xNum1 As Integer
Dim xNum2 As Integer
Dim WorkRng As Range
Dim xWs As Worksheet

xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
xRowsCount = WorkRng.Rows.Count
xInterval = Application.InputBox("Enter row interval. ", xTitleId, 1, Type:=1)
xRows = Application.InputBox("How many rows to insert at each interval? ", xTitleId, 1, Type:=1)

xNum0 = WorkRng.Row
xNum1 = WorkRng.Row + xInterval
xNum2 = xRows + xInterval

Set xWs = WorkRng.Parent

For i = 1 To Int(xRowsCount / xInterval)
    'This part creates new rows at every interval
    xWs.Range(xWs.Cells(xNum1, WorkRng.Column), xWs.Cells(xNum1 + xRows - 1, WorkRng.Column)).Select
    Application.Selection.EntireRow.Insert

    'This part attempts to autofill from the one above, but it doesn't work. I don't know the proper notation.

    Set SourceRange = xWs.Range("xNum0:xNum1")
    Set fillRange = xWs.Range("xNum1:WorkRng.Column")
    SourceRange.AutoFill Destination:=fillRange

    xNum1 = xNum1 + xNum2

Next

End Sub




'This is the code to auto fill a particular range. Need to figure out how to make this very every i in the rows



' Set SourceRange = Worksheets("Sheet1").Range("A1:A2")

' Set fillRange = Worksheets("Sheet1").Range("A1:A20")

' SourceRange.AutoFill Destination:=fillRange



' Selection.AutoFill Destination:=Range("B4:B7"), Type:=xlFillDefault
vba excel
1 Answers

You can set the ranges using Resize and Offset.

Option Explicit

Sub fill()

    Const TITLE = "KutoolsforExcel"
    Const LIMIT = 100 ' useful during testing

    Dim ws As Worksheet, WorkRng As Range
    Dim rng1 As Range, rng2 As Range
    Dim iInterval As Integer, iInsertRows As Integer
    Dim iRowsCount As Long
    Dim i As Long, n As Long, c As Integer, nc As Integer

    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", TITLE, WorkRng.Address, Type:=8)
    
    iRowsCount = WorkRng.Rows.Count
    If iRowsCount > LIMIT Then
        MsgBox "Row limit is " & LIMIT, vbCritical, WorkRng.Address
        Exit Sub
    End If

    iInterval = Application.InputBox("Enter row interval. ", TITLE, 1, Type:=1)
    iInsertRows = Application.InputBox("How many rows to insert at each interval? ", TITLE, 1, Type:=1)
    If iInterval = 0 Or iInsertRows = 0 Then
        MsgBox "Zero value entered", vbCritical
        Exit Sub
    End If
    
    Set ws = WorkRng.Parent
    
    c = WorkRng.Column
    nc = WorkRng.Columns.Count  
    i = WorkRng.Row + iInterval

    Application.ScreenUpdating = False
    For n = 1 To Int(iRowsCount / iInterval)
        
        Set rng1 = ws.Cells(i, c).Resize(iInsertRows, nc)
        rng1.EntireRow.Insert
        Set rng1 = ws.Cells(i - 1, c).Resize(1, nc)
        Set rng2 = rng1.Resize(iInsertRows + 1, nc)
        
        rng1.AutoFill Destination:=rng2, Type:=xlFillDefault
        ' highlight rows inserted
        rng1.Offset(1, 0).Resize(iInsertRows, nc).Interior.ColorIndex = 6 ' yellow
        
        i = i + iInsertRows + iInterval
        
    Next
    Application.ScreenUpdating = True
    MsgBox n & " blocks inserted", vbInformation
End Sub
user_127045930
Related