Dynamically insert rows - vba

Question

I want to ask couple of Qs.
1.
Code below dynamically add new rows before the cell that contain "7000"
Code works but it is not very efficient. It slows down where I used For Next loop to insert new rows. Is there better way to insert rows dynamically before cell that contain "7000".
Sub PLFinalReport()
Dim XCount As Integer
Dim YCount As Integer
Dim i As Integer
JobsPivot.Activate
XCount = JobsPivot.Range("H3", Range("H3").End(xlDown)).Count
PLJob.Activate
Range("G6", Range("G6").End(xlDown)).Find("7000").Select
YCount = Range(ActiveCell, ActiveCell.End(xlUp)).Count - 2
For i = 1 To (XCount - YCount)
ActiveCell.EntireRow.Insert
Next i
JobsPivot.Activate
JobsPivot.Range("H3", Range("H3").End(xlDown).End(xlToRight)).Copy
PLJob.Range("G6").PasteSpecial
End Sub
Also I want to copy the forumulas from cell B444 to F44 and paste them all the way down to the last row containing formulas. Same way as we do in the excel with fill handle.
Thanks

Answer 1

Please try this code.
Sub PLFinalReport()
' 13 Feb 2018
Dim SourceRange As Range
Dim TargetRange As Range
Dim R As Long
Dim C As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set SourceRange = JobsPivot.Range("H3")
With SourceRange
C = .End(xlToRight).Column - .Column + 1
Set SourceRange = .Resize((.End(xlDown).Row - .Row + 1), C)
End With
C = 7 ' Column G
With PLJob
R = MatchRow("7000", .Cells(6, C)) ' = G6
If R Then
Set TargetRange = Range(.Cells(R, C), .Cells((R + SourceRange.Rows.Count - 1), C))
TargetRange.Rows.EntireRow.Insert
SourceRange.Copy .Cells(R, "H") ' column H
Else
' "7000" wasn't found
End If
End With
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Private Function MatchRow(ByVal Crit As Variant, _
ByVal StartCell As Range) As Long
' 13 Feb 2018
Dim Rng As Range
Dim Rl As Long
Dim Fnd As Range
With StartCell.Worksheet
Rl = .Cells(.Rows.Count, 1).End(xlUp).Row ' find last used row
Set Rng = Range(.Cells(StartCell.Row, StartCell.Column), _
.Cells(Rl, StartCell.Column))
End With
With Rng
Set Fnd = .Find(What:=Crit, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
On Error Resume Next
MatchRow = Fnd.Row
End Function
I was more careful with the Find function because there are many reasons why the item might not be found causing an "unexplained" crash. One of the reasons is that Excel remembers most of the settings of your last use of Find. If your code doesn't make clear which settings to use you may not always get the same result with the same code. Consider the setting of the LookAt property in this regard.
I didn't look into your second question because - in essence - it is another question.

Answer 2

you can do that in one statement like:
Range("G6", Range("G6").End(xlDown)).Find("7000").Resize(XCount - YCount).EntireRow.Insert
as for your second question you can use something like follows (explanations in comments, so you can adjust it to your needs):
With PLJob 'reference PLJob
With .Range("B2", .Cells(.Rows.Count, 1).End(xlUp)) 'reference its columns A and B cells from row 2 down to column A last not empty one
.Formula = .Resize(1).Formula 'copy/paste formulas
End With
End With