Macro to Insert a Row in Excel

[KitK369]

I have been searching the internet and watching Youtube videos for days trying to create a macro in VBA that will enter a row above a specific text string in a worksheet in Excel. Every worksheet I would perform this macro on has the term "Actual Earnings" somewhere between cells A19 and A22. What I would like for the macro to do is find the Text "Actual Earnings" and insert rows above the text depending on where it falls in the spreadsheet. If it falls in cell A22, I don't want it to do anything. If it falls in A21, I want it to enter 1 row. If it falls in A20, I want it to enter two rows and if it falls into A19 I want it to enter 3. I'm trying to make each worksheet in my workbook uniform with the row "Actual Earnings" always falling in cell A22. Can anyone help me formulate this Macro? I found one that will enter a row but it enters the row above where I have selected a cell in the workbook as opposed to entering it above the text string and I'm not advanced enough to understand how to do everything I want it to. I would also like for it to work without a command button. Here is what I have to start with, I don't even know if it'll work for what I'm trying to do. Any help would be greatly appreciated!!

Sub InsertRow()


Dim Found As Range
Set Found = Columns("A").EntireRow.Find(what:="Actual:", LookIn:=xlValues, Lookat:=xlWhole)
If Not Found Is Nothing Then Found.Select
Rows(Selection.Row).Insert Shift:=xlDown


End Sub

 

[mumps]

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim found As Range
    Set found = Range("A19:A21").Find("Actual", LookIn:=xlValues, lookat:=xlPart)
    If Not found Is Nothing Then
        Select Case found.Row
            Case Is = 19
                Rows(19).Insert
            Case Is = 20
                Cells(20, 1).EntireRow.Resize(2).Insert
            Case Is = 21
                Cells(21, 1).EntireRow.Resize(3).Insert
        End Select
    End If
    Application.ScreenUpdating = True
End Sub

 

[KitK369]

Thanks for the response! I gave this a shot and now it doesn't appear to be entering any rows at all. It doesn't give me an errors, but it doesn't appear to be doing anything at all.

 

[KitK369]

Actually - I think it was because my cells were merged. It's working perfectly now! Thank you so much for the help!

 

[mumps]

You are very welcome. Merged cells almost always give Excel macros problems. You should avoid merging cell if at all possible.

 

[KitK369]

Do you know how I can make this repeat for multiple sheets within a workbook? I have over 50 sheets and I'm trying to avoid having to use the shortcut on every sheet.

 

[KitK369]

Do you know how I can make this repeat for multiple sheets within a workbook? I have over 50 sheets and I'm trying to avoid having to use the shortcut on every sheet. It would also be great if the Macro included a way to un-merge the cells if they equal "Actual Earnings." As it is right now I'll have to go through and manually unmerge the cells where the "actual Earnings" is entered.

 

[mumps]

Are there any sheets in your workbook that you want to exclude? If so, what are their names?

 

[KitK369]

Are there any sheets in your workbook that you want to exclude? If so, what are their names?

I shouldn't need any sheets excluded. Across the entire workbook if the text "Actual Earnings" falls between cells A19 and A21 I will need them to unmerge so that the macro will work. And it will need to be repeated throughout the entire workbook.

Hope this answers your question. Thanks again for all of your help! The document comes out of a database with these cells already merged.

 

[mumps]

Try:

Sub InsertRows()
    Application.ScreenUpdating = False
    Dim found As Range, ws As Worksheet
    For Each ws In Sheets
        Set found = ws.Range("A19:A21").Find("Actual", LookIn:=xlValues, lookat:=xlPart)
        If Not found Is Nothing Then
            If found.MergeCells Then
                found.UnMerge
            End If
            Select Case found.Row
                Case Is = 19
                    ws.Rows(19).Insert
                Case Is = 20
                    ws.Cells(20, 1).EntireRow.Resize(2).Insert
                Case Is = 21
                    ws.Cells(21, 1).EntireRow.Resize(3).Insert
            End Select
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub