Home > Net >  Excel Macro to Insert Row, with formatting, below header of named range
Excel Macro to Insert Row, with formatting, below header of named range

Time:09-02

I would like the user to be able to click the green button on the right of each named range to insert a new data entry row below the named range header. The code I have hard codes the insert row number for the first named range. I need a way to have the code to be smart enough to know that the first row below the header of the second, third, & forth named range will changed.

Another big part is that the inserted row needs to have the same formatting (dropdowns, formulas, color, etc.) as the rows below.

Image of Data Entry Worksheet

First named range button code:

Sub BidSheetAddRow_Materials()
'   BidSheetAddRow_Materials Macro

    Rows("19:19").Select

    Selection.Copy

    Rows("19:19").Select

    Selection.Insert Shift:=xlDown

    Range("A19").Select

    Application.CutCopyMode = False

    Selection.ClearContents

    Range("C19").Select

    Selection.ClearContents

    Range("K19").Select

    Selection.ClearContents
End Sub

CodePudding user response:

Based on the screenshot all table headers are in colA, the first input row is 3 cells below the header, and the first input cell on each table row is a merged cell.

So this works for me:

Sub AddMaterial()
    AddRow "MATERIALS"
End Sub

Sub AddRate()
    AddRow "RATE"
End Sub

Sub AddRow(TableHeader As String)
    Dim f As Range, ws As Worksheet, c As Range
    
    Set ws = ThisWorkbook.Worksheets("Input")                        'or whatever
    Set f = ws.Columns("A").Find(what:=TableHeader, lookat:=xlWhole) 'find the header
    
    If Not f Is Nothing Then
        Set c = f.Offset(3)                             'step down to first input row below header
        Do While c.Offset(1).MergeArea.Cells.Count > 1  'keep looping while `c` is merged
            Set c = c.Offset(1)
        Loop
        c.Offset(1).EntireRow.Insert shift:=xlDown 'insert
        c.EntireRow.Copy c.Offset(1)               'copy
        c.Offset(1).EntireRow.ClearContents        'clear new row
    Else
        MsgBox "Table header '" & TableHeader & "' not found!"
    End If
End Sub

Before/after:

enter image description here

  • Related