VBA code to insert row when a search criteria is found

[John T]

I have data in cells B2:E2 and this can go down 100+ rows.

In column B i have invoice numbers but some cells contain the word "Deposit".

I have sorted this data so that the invoice numbers appear first and then all the Deposits.

I need a code to find the first instance of the word "Deposit" and to insert a row so that all the invoices and Deposits are seperated by a single row.

Thanks

 

[tweedle]

Hi John T,

Something like this - inserts a row at all instances of 'Deposit' in Column B

Sub InsertRowAtDeposit()


    Dim Found As Range, FirstFound As Range, LastFound As Range


    'Init
    Set Found = ActiveSheet.Range("B:B").Find( _
                What:="Deposit", _
                After:=Range("B1"), _
                LookIn:=xlValues, _
                Lookat:=xlWhole, _
                SearchOrder:=xlByRows, _
                MatchCase:=True)


    If Not Found Is Nothing Then
        Set FirstFound = Found
        Set LastFound = Found


        'Loop
        Do
            Found.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=False


            Set Found = ActiveSheet.Range("B:B").Find( _
                        What:="Deposit", _
                        After:=LastFound, _
                        LookIn:=xlValues, _
                        Lookat:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        MatchCase:=True)


            Set LastFound = Found


            DoEvents
        Loop While Found.Address <> FirstFound.Address


    End If


End Sub

 

[John T]

Thanks, this works except i need it to stop when it finds the first deposit.

Your code inserts a row between every instance of the word deposit.

I just need it to insert one row.

 

[tweedle]

Thanks, this works except i need it to stop when it finds the first deposit.

Your code inserts a row between every instance of the word deposit.

I just need it to insert one row.

I didn't understand your layout initially. You don't have sub-totalling per-se, just an ordered list.

That shortens it considerably then.

Sub InsertRowAtDeposit()


    Dim Found As Range


    'Init
    Set Found = ActiveSheet.Range("B:B").Find( _
                What:="Deposit", _
                After:=Range("B1"), _
                LookIn:=xlValues, _
                Lookat:=xlWhole, _
                SearchOrder:=xlByRows, _
                MatchCase:=True)


    If Not Found Is Nothing Then Found.EntireRow.Insert Shift:=xlShiftDown, CopyOrigin:=False
End Sub

 

[John T]

Thanks, that does just what i need it to do.