Run-time error '1004': Insert method of Range class failed when running VBA to insert cells

[Dan Pilgrim]

[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]661[/TD]
[TD]Delete[/TD]
[TD]Item[/TD]
[TD]809[/TD]
[TD]Dan[/TD]
[TD]Pilgrim[/TD]
[TD]3[/TD]
[TD]280[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]721[/TD]
[TD]Delete[/TD]
[TD]Matrix[/TD]
[TD]809[/TD]
[TD]Dan[/TD]
[TD]Pilgrim[/TD]
[TD]3[/TD]
[TD]280[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]727[/TD]
[TD]Amend[/TD]
[TD]Matrix[/TD]
[TD]-[/TD]
[TD]Cr[/TD]
[TD]Int[/TD]
[TD]Det[/TD]
[TD]809[/TD]
[TD]Dan[/TD]
[TD]Pilgrim[/TD]
[TD]3[/TD]
[TD]280[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

Hi all,

I've been considering this for days and have now given up. I have a spreadsheet much like the one above and I'm trying to develop a macro to insert 4 cells from column D based on the value of column A.

I've come up with the following so far, and know it doesn't do it from D, but get a Run-time error '1004'. Please help.

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = .UsedRange.Cells(1).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To Firstrow Step -1
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
If .Value = "661" Or "721" Then .Insert Shift:=x4ToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
End With
Next Lrow
End With
ActiveWindow.View = ViewMode
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[SteveO59L]

so, for row 2, the entries in e2:h2 get shifted to i2:l2?

 

[Dan Pilgrim]

Eventually I need to be able to shift cells D2:H2 & D3:H3 to H2:L2 & H3:L3 respectively because the values in column A for those 2 rows satisfy the argument if that makes any sense.

 

[SteveO59L]

something like

Dim c As Range, rng
Set rng = Range("a1:a3")
For Each c In rng
If c.Value = 661 Or c.Value = 721 Then
c.Offset(0, 3).Select
numRows = Selection.Rows.Count
numColumns = Selection.Columns.Count
Selection.Resize(numRows + 0, numColumns + 4).Select
Selection.Cut
c.Offset(0, 7).Select
ActiveSheet.Paste
End If
Next c

 

[Dan Pilgrim]

Spot on! You're an absolute legend. Thank you very much

 

[SteveO59L]

Thanks for the feedback