Home > Back-end >  VBA to insert or delete rows in named range based on spill range
VBA to insert or delete rows in named range based on spill range

Time:08-28

Cross posted at: https://www.mrexcel.com/board/threads/vba-to-insert-or-delete-rows-in-named-range-based-on-spill-range.1214814/#post-5937281

I have a named range "nameList" (B3:E20) that are populated by a spill range from dynamic array formula in cell B3, and there's a table just below cell B24. If the spill range row count are less or more than the number of rows of nameList then I want the unused cell to be deleted or insert new rows if not enough, Basically I would like the nameList to be resized dynamically based on spill range.

Spill range data are sometimes 2 rows only (too much unused rows) or up to 50 rows (spill error due to the table below) that's why I want the nameList to be resized

I've been looking for similar topic for numerous hours now but still no luck.

Here's a code I made so far from the answer below.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lsRow As Long
Dim lsEndRow As Long

lsRow = Range("B3").End(xlUp).Row
lsEndRow = lsRow

    Do While lsEndRow = Range("B" & Rows.Count).End(xlUp).Row
        If lsEndRow   1 > "" Then
        Range(lsEndRow).EntireRow.Insert
        lsEndRow = Range("B" & Rows.Count).End(xlUp).Row
        End If
    Loop
    
Application.CutCopyMode = False
Application.EnableEvents = True
ActiveSheet.Range("B3").Select
End Sub

CodePudding user response:

This should be a good start.

Sub Copy_Anniversary_Down()

Dim lsRow As Long
Dim lsEndRow As Long

lsRow = Range("B3").End(xlUp).Row
lsEndRow = lsRow
Do While lsEndRow <= Range("B" & Rows.Count).End(xlUp).Row
    If Range("B" & lsEndRow   1) <> "" Then
    Range("B" & lsEndRow   1, "D" & lsEndRow   1).Copy
    Range("B" & lsEndRow   1, "D" & lsEndRow   1).PasteSpecial _
    Transpose:=True
    lsEndRow = vba.Application.ActiveSheet.Range("Z" &     vba.Application.Rows.Count).End(xlUp).Row
    End If
Loop
Application.CutCopyMode = False
Application.EnableEvents = True
ActiveSheet.Range("B3").Select

End Sub

CodePudding user response:

SOLVED but in different approach.

My workaround is to insert plenty rows and trigger the dynamic array formula.

Range("B3").Rows.End(xlDown).Offset(1).Select
Selection.EntireRow.Resize(50).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Then delete the empty rows in nameList.

Range("nameList").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Resize(Selection.Rows.Count - 1).Select
Selection.EntireRow.Delete
  • Related