Modify Recorded Macro to Insert Rows in any Area of the Worksheet. RRS feed

  • Question

  • Hi Team.

    I'm working in Excel 2010 and pretty new to VBA. I've searched and searched for answers and can't find answers although I find similar questions as mine with great answers but didn't seem to work for my case.

    I would like to find a phrase in  Column D (i.e. "TPF FUND V" as the phrase to find) then insert a number blank rows just above the row that contains the phrase and copy the functions from an existing row that's above newly added row.   The number of new rows to insert will change at times.  Two, three, sometimes 5 rows at a time.

    I recorded a macro which works fine except that the range to insert row(s) will frequently change.  Can I modify the recorded code below to add row(s) in various areas of the worksheet? If so, what would I change?

    Listed below is the code from my recorded macro that will be assigned to a button:

    Sub Test_InsRow()
    ' Test_InsRow Macro
    ' Select tabs and insert row in same area across selected worksheets

        Sheets(Array("All_Fund_Series", "MAPMG", "SCPMG")).Select
        Cells.Find(What:="TPF FUND V - SERIES J TOTALS", After:=ActiveCell, LookIn _
            :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False).Activate
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.AutoFill Destination:=Range("A212:W213"), Type:=xlFillDefault
        Sheets.Add After:=Sheets(Sheets.Count)

    End Sub

    Thanks in advance.

    Sunday, January 27, 2013 4:35 AM

All replies

  • Here's a start:

    Sub Test_InsRow()
    Const RowsToInsert = 2
    Dim Rng As Range
        Set Rng = Nothing
        Set Rng = Range("D:D").Find(What:="TPF FUND V - SERIES J TOTALS", LookIn _
            :=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
            xlNext, MatchCase:=False, SearchFormat:=False)
    '    Rows("213:213").Select
        If Not Rng Is Nothing Then  'If value found
            Range(Rng.Row & ":" & Rng.Row + RowsToInsert - 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
            Range("A" & Rng.Row - RowsToInsert - 1 & ":W" & Rng.Row - RowsToInsert - 1).AutoFill _
                        Destination:=Range("A" & Rng.Row - RowsToInsert - 1 & ":W" & Rng.Row - RowsToInsert + 1)
        End If
    End Sub

    Rod Gill

    The one and only Project VBA Book

    Rod Gill Project Management

    Sunday, January 27, 2013 9:52 PM