VBA - Copying Formulas down

[cmholmes]

I have the code below. I'm trying to copy the formulas down from 'A2' but when I run the sub it will repeat the header line. What am I missing?

Sub Non_Grad()

Dim last_row_non_grad As Long, non_grad_count As Integer
Dim curSheet As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set curSheet = ActiveWorkbook.ActiveSheet


With ActiveWorkbook.Worksheets("Non_Grad")

.Activate



'Create data columns
.Range("A1").FormulaR1C1 = "StuNum"
.Range("B1").FormulaR1C1 = "StudentName"
.Range("C1").FormulaR1C1 = "Phone"
.Range("D1").FormulaR1C1 = "Email"
.Range("E1").FormulaR1C1 = "Campus"
.Range("F1").FormulaR1C1 = "Program"
.Range("G1").FormulaR1C1 = "TotalMonths"

'Define last row of data
last_row_non_grad = .Range("A5000").End(xlUp).Row
non_grad_count = Application.Sum(Range("Data!AO:AO"))

'Create data formulas
.Range("A2").FormulaArray = "=IF(ROWS(A$2:A2)<=" & non_grad_count & ",INDEX(INDIRECT(A$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(A$2:A2))),"""")"
.Range("B2").FormulaArray = "=IF(ROWS(B$2:B2)<=" & non_grad_count & ",INDEX(INDIRECT(B$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(B$2:B2))),"""")"
.Range("C2").FormulaArray = "=IF(ROWS(C$2:C2)<=" & non_grad_count & ",INDEX(INDIRECT(C$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(C$2:C2))),"""")"
.Range("D2").FormulaArray = "=IF(ROWS(D$2:D2)<=" & non_grad_count & ",INDEX(INDIRECT(D$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(D$2:D2))),"""")"
.Range("E2").FormulaArray = "=IF(ROWS(E$2:E2)<=" & non_grad_count & ",INDEX(INDIRECT(E$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(E$2:E2))),"""")"
.Range("F2").FormulaArray = "=IF(ROWS(F$2:F2)<=" & non_grad_count & ",INDEX(INDIRECT(F$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(F$2:F2))),"""")"
.Range("G2").FormulaArray = "=IF(ROWS(G$2:G2)<=" & non_grad_count & ",INDEX(INDIRECT(G$1),SMALL(IF(Non_Grad=1,ROW(Non_Grad)-ROW(Data!$AO$2)+1),ROWS(G$2:G2))),"""")"




'Copy down formulas, calculate, and hardcode
With .Range("A2:G" & last_row_non_grad)
.FillDown
.Calculate
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
'Sort data
With .Sort.SortFields
.Clear
.Add Key:=Range("E1:E" & last_row_non_grad), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Add Key:=Range("F1:F" & last_row_non_grad), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
End With
With .Sort
.SetRange Range("A1:G" & last_row_non_grad)
.Header = xlYes
.Apply
End With


'Format data
With .Range("A:G")
.WrapText = True
.WrapText = False

With .Font
.Name = "Tahoma"
.Size = 8
End With

End With

.Range("1:1").Font.Bold = True

With .Range("A:G")
.Columns.AutoFit
.HorizontalAlignment = xlCenter
End With

.Range("A2").Select
ActiveWindow.FreezePanes = True

End With

curSheet.Activate

Application.ScreenUpdating = True
End Sub

 

[Caleeco]

Code looks ok to me... i tested up until the fill down line.. and it did as expected. Have you tried stepping though your code (F8 Key) to see which line causes the problem? You can also check the value of last_row_non_grad is not mistakenly calculated as '1'

side note, you can reduce the section of code for headers to 1 line as follows:

'Create data columns
.Range("A1:G1").Value = Array("StuNum", "StudentName", "Phone", "Email", "Campus", "Program", "TotalMonths")

Regards
Caleeco