VBA insert new row and paste data

[oksox]

Hi,

I'm working on a small code to copy data from one worksheet and past in a report on the other. I'm really close to finishing up, but my limited understanding of VBA has me scratching my head. Hoping someone out there wouldn't mind to help me out.

I've attached a spreadsheet for you to view and code. It is copying correctly based on the criteria, and pasting in the blue highlights. But what I need to do now is have it insert a new row on the yellow hightlighted row for, and then paste on that new row. This will keep 2 rows between the data and the subtotal.


Any help would be greatly appreciated.

[mdmackillop]

You want to use Find rather than looping. Also by refering to the sheets as below, there is no need to Activate

If Cells(j, 1) = catagory And Cells(j, 3) = account Then
Set tgt = Analysis.Columns(5).Find(catagory, lookat:=xlPart).Offset(-2, -1)
Range(Cells(j, 4), Cells(j, 6)).Copy tgt
tgt.Offset(1).EntireRow.Insert
End If

[mdmackillop]

A few new concepts to explore

Option Explicit
Sub search_and_extract()
    '1.  declare and set variables
    '2.  find records that match criteria, insert row and past them in report sheet
    
    Dim Query As Worksheet
    Dim Analysis As Worksheet
    Dim account As Long
    Dim arr As Range, a As Range, c As Range, tgt As Range
    'set variables
    Set Analysis = Sheet2
    Set Query = Sheet1
    
    account = Analysis.Range("E2").Value
    Query.Columns("C:C").AutoFilter Field:=1, Criteria1:=account
    
    Set arr = Analysis.Columns(2).SpecialCells(xlCellTypeConstants)
    For Each a In arr.Cells
        Set c = Query.Columns(1).Find(a)
        If Not c Is Nothing Then
            Set tgt = Analysis.Columns(5).Find(a, lookat:=xlPart).Offset(-2, -1)
            c.Offset(, 3).Resize(, 3).Copy tgt
            tgt.Offset(1).EntireRow.Insert
        End If
    Next
    Query.Columns("C:C").AutoFilter
End Sub

[oksox]

Thank you that worked perfect! I really appreciate your help as I'm learning!