Why is Excel 2007 macro creating extra blank rows?

[childofthe1980s]

Hello:

I have created a macro in Excel 2003. The users who run this macro on their
workstations, however, are using Excel 2007.

The macro in 2007 runs perfectly, except for one thing. The macro, after
subtotaling the amounts in the rows, is placing blank rows between the
subtotaled data and the Grand Total footer.

It is strange that this behavior is occurring in Excel 2007 but not 2003.
And, depending on the date that the macro is run for, the number of blank
rows varies from between say 8 and 12 rows.

Below is the code for my macro. If someone can give me any insight as to
how to modify this code to not show blank rows, I'd appreciate it!

Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Cells.Select
Columns("C:C").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Columns( _
"A:A"), Unique:=True
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A16").Select
ActiveCell.FormulaR1C1 = "=COUNTA(Extract)-1"
Range("A17").Select
ActiveCell.FormulaR1C1 = _
"=IF(R[-15]C[9]=""P"", ""PHOENIX"", IF(R[-15]C[9]=""T"", ""TAMPA"",
IF(R[-15]C[9]=""TU"", ""TULSA"", IF(R[-15]C[9]=""H"", ""HOUSTON"",
IF(R[-15]C[9]=""A"", ""ATLANTA"")))))"
Range("I2").Select
Selection.Copy
Range("A18").Select
ActiveSheet.Paste
Columns("C:J").Select
Application.CutCopyMode = False
Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A35").Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A35").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Range("A35").Select
Application.CutCopyMode = False
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.ClearContents
Range("A35").Select
Selection.Copy
Range("F1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=IF(R[4]C[4]=""P"", ""PHOENIX"", IF(R[4]C[4]=""T"", ""TAMPA"",
IF(R[4]C[4]=""TU"", ""TULSA"", IF(R[4]C[4]=""H"", ""HOUSTON"",
IF(R[4]C[4]=""A"", ""ATLANTA"")))))"
Range("A35").Select
Selection.ClearContents
Range("I5").Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste
Range("A37").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("F3").Select
ActiveCell.FormulaR1C1 = "=COUNTA(Extract)-1"
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Selection.EntireColumn.Hidden = True
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Columns("E:G").Select
Columns("E:F").Select
Selection.Delete Shift:=xlToLeft
Selection.EntireColumn.Hidden = True
Range("C1").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D3").Select
ActiveCell.FormulaR1C1 = "ORDERS"
Range("C13").Select
Selection.Font.Bold = True
Columns("D").EntireColumn.AutoFit
Range("B1").Select
ActiveSheet.Outline.ShowLevels RowLevels:=2
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Columns("B:B").EntireColumn.AutoFit
Columns("B").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B1").Select
End Sub

 

[broro183]

hi,

I can't see any clear reason why "blank rows" are being inserted bu
here is a modified version of your code which should do the same thin
more efficiently - if I've made all the correct changes when removin
".select" statements.

The macro currently has some cell addresses "hardcoded" into the cod
(eg "a35") which could be made flexible for a varying numbers of rows
This could cause blank rows to "appear" but it should be consistent i
both versions of Excel. Do the users have different settings under th
Subtotal option?



Code
-------------------
Option Explicit
Sub SelectsRemoved()
application.screenupdating = false
Columns("A:A").Insert Shift:=xlToRight
Columns("C:C").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns( _
"A:A"), Unique:=True
Columns("A:A").Insert Shift:=xlToRight
Range("A16").FormulaR1C1 = "=COUNTA(Extract)-1"
Range("A17").FormulaR1C1 = _
"=IF(R[-15]C[9]=""P"", ""PHOENIX"", IF(R[-15]C[9]=""T"", ""TAMPA"",IF(R[-15]C[9]=""TU"", ""TULSA"", IF(R[-15]C[9]=""H"", ""HOUSTON"",IF(R[-15]C[9]=""A"", ""ATLANTA"")))))"
Range("I2").Copy Range("A18")
Columns("C:J").Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(5), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
'Rows("1:1").Select
Rows("1:3").Insert Shift:=xlDown
Range("A35").Copy Range("F1")
Range("F1").FormulaR1C1 = _
"=IF(R[4]C[4]=""P"", ""PHOENIX"", IF(R[4]C[4]=""T"", ""TAMPA"",IF(R[4]C[4]=""TU"", ""TULSA"", IF(R[4]C[4]=""H"", ""HOUSTON"",iF(R[4]C[4]=""A"", ""ATLANTA"")))))"
Range("A35").ClearContents
Range("I5").Copy Range("F2")
Range("A37").ClearContents
Range("F3").FormulaR1C1 = "=COUNTA(Extract)-1"
Columns("A:A").Delete Shift:=xlToLeft
Columns("A:A").EntireColumn.Hidden = True
Columns("B:C").Delete Shift:=xlToLeft
Columns("E:F").Delete Shift:=xlToLeft
Columns("E:F").EntireColumn.Hidden = True
With Range("C1")
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D3").FormulaR1C1 = "ORDERS"
Range("C13").Font.Bold = True
Columns("D").EntireColumn.AutoFit
ActiveSheet.Outline.ShowLevels RowLevels:=2
Columns("B:B").EntireColumn.AutoFit
With Columns("B")
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("B1").Select
End With
application.screenupdating = true
End Su