Find certain value in excel and add entire row below it using Vbscript

Question

What i'd like to do, is write a VB macro that will scan the entire column (Column F) searing for "Year Total:" and then insert an entire row below it.

I have this:

Sub Macro2() ' ' Macro2 Macro ' ' Keyboard Shortcut: Ctrl+a

Dim C As Variant
Dim FirstRow As Integer

With Worksheets(1).Range("F1:F4000")
    Set C = .Find("Year Total:", LookIn:=xlValues)
    If Not C Is Nothing Then
        FirstRow = C.Row
        Do
            C.Offset(1, 0).Insert Shift:=xlDown
            Set C = .FindNext(C)
        Loop While Not C Is Nothing And C.Row <> FirstRow
    End If


End With

End Sub

However, it only adds cells in, not an entire row.

I'd also like to add into the code, for it to also search for "Grand Total:" in the same column and add three rows under it as well. I was just going to write two scripts, however if I can mash them all together in one, that would be excellent.

Answer 1

Ok here you go, I just tested it and this does the trick. I'm sure there's a cleaner way to do it, but it sounds like you're after a quick n' dirty solution so this hopefully works for you. :)

' Get last row
intLastRow = ActiveSheet.Range("F" & Rows.Count).End(xlUp).Row

' Loop till last row
intRow = 0
For Each strColFValue In ActiveSheet.Range("F1:F" & intLastRow).Value
    intRow = intRow + 1

    ' If found year, insert row below
    If InStr(UCase(strColFValue), "YEAR TOTAL:") > 0 Then
        Range("F" & intRow + 1).Select
        Selection.EntireRow.Insert
        intRow = intRow + 1
    End If

    ' If found grand total, insert 3 rows below
    If InStr(UCase(strColFValue), "GRAND TOTAL:") > 0 Then
        Range("F" & intRow + 1).Select
        Selection.EntireRow.Insert
        Selection.EntireRow.Insert
        Selection.EntireRow.Insert
        intRow = intRow + 3
    End If

Next