Deleting blank (Cells/Rows) in Excel-VBA

[MyFlight]

Help I have a macro that runs multiple formulas. However, when the formulas
are
finished I am left with about 64000 blank lines. I am unable to insert a
row on the
worksheets as I get a Run-Time Error 1004 (Try to locate the last Nonblank
Cell
using CTRL-END).

Here is a same of some of the formulas I am running ( the macro is very
large).

Range("AA1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaI",
RefersToR1C1:="=Trunks!R1C27"
Range("AB1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaJ",
RefersToR1C1:="=Trunks!R1C28"
Range("AC1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaK",
RefersToR1C1:="=Trunks!R1C29"
Range("AD1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaL",
RefersToR1C1:="=Trunks!R1C30"
Range("AE1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaM",
RefersToR1C1:="=Trunks!R1C31"
Range("AF1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaN",
RefersToR1C1:="=Trunks!R1C32"
Range("AG1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaO",
RefersToR1C1:="=Trunks!R1C33"
Range("AH1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaP",
RefersToR1C1:="=Trunks!R1C34"
Range("AI1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaQ",
RefersToR1C1:="=Trunks!R1C35"
Range("AJ1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaR",
RefersToR1C1:="=Trunks!R1C36"
Range("AK1").Select
ActiveWorkbook.Names.Add Name:="TrunkFormulaS",
RefersToR1C1:="=Trunks!R1C37"

'INSERT ANCHOR CELL FORMULA FOR THIS SECTION TO COPY AND PASTE FORMULAS TO
BOTTOM OF SHEET
Range("AA1").Select
ActiveCell.FormulaR1C1 =
"=IF(RC[-17]>"""",IF(RC11>0,OFFSET(RC[-16],0,0),""""),"""")"
'Defines a variable called anchor cell
Application.Goto Reference:="TrunkFormulaI", Scroll:=False
Selection.Copy
AnchorCell = ActiveCell.Offset(1, 0).Address
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
EndCell = ActiveCell.Offset(0, 1).Address
Range(AnchorCell, EndCell).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Application.Goto Reference:="TrunkFormulaI", Scroll:=False
Range("G:G").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False


'RUN-TIME ERROR 1004
Range("A1").Select
Selection.EntireRow.Insert



Any help would be appreciated.

 

[AnotherHiggins]

A couple of comments:

[tab]* When you're defining EndCell, you seem to be going all the way to the end of the sheet. That means that there is nothing else in column AA other than the header row. See FAQ707-2112 or FAQ707-2115 for tips on how to find the last row without resorting to filling up all 65,536 rows (1,048,576 rows in the new Excel).

[tab]* Avoid Activating cells. This slows down your code. For example, this:

    Range("AA1").Select
    ActiveWorkbook.Names.Add Name:="TrunkFormulaI", RefersToR1C1:="=Trunks!R1C27"

adds no function over this:

    ActiveWorkbook.Names.Add Name:="TrunkFormulaI", RefersToR1C1:="=Trunks!R1C27"

and it is slower.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[SkipVought]

This question has been asked so many times in this forum. I know that the TT Search is disabled, but try the Google TT Search.

Check out using AutoFilter to select only the rows you want to delete and then select the rows and delete. Check out the SpecialCells(xlcelltypevisible) property also.

Skip,

_[red][/red]