Deleting blank (Cells/Rows) in Excel-VBA

V

VexedFist

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).

ActiveWorkbook.Names.Add Name:="TrunkFormulaI", RefersToR1C1:="=Trunks!R1C27"
ActiveWorkbook.Names.Add Name:="TrunkFormulaJ", RefersToR1C1:="=Trunks!R1C28"
ActiveWorkbook.Names.Add Name:="TrunkFormulaK", RefersToR1C1:="=Trunks!R1C29"
ActiveWorkbook.Names.Add Name:="TrunkFormulaL", RefersToR1C1:="=Trunks!R1C30"
ActiveWorkbook.Names.Add Name:="TrunkFormulaM", RefersToR1C1:="=Trunks!R1C31"
ActiveWorkbook.Names.Add Name:="TrunkFormulaN", RefersToR1C1:="=Trunks!R1C32"
ActiveWorkbook.Names.Add Name:="TrunkFormulaO", RefersToR1C1:="=Trunks!R1C33"
ActiveWorkbook.Names.Add Name:="TrunkFormulaP", RefersToR1C1:="=Trunks!R1C34"
ActiveWorkbook.Names.Add Name:="TrunkFormulaQ", RefersToR1C1:="=Trunks!R1C35"
ActiveWorkbook.Names.Add Name:="TrunkFormulaR", RefersToR1C1:="=Trunks!R1C36"
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").EntireRow.Insert


Any help would be appreciated.
 
J

JLGWhiz

You can try this to get rid of the blank rows. Pick a column that would
normally have had data all the way down before the macro ran. For demo
purposes let's use col A.

Sub delBlnkRws()
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("$A$1:$A" & lastRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Try it on a copy first to make sure it is what you want.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top