VBA Row looping Issues

[cmholmes]

Hello I have pretty detailed code but I'm having an issue that when there is only supposed to be one line of data after a header it repeats the header instead of the first line of data. If there is more than one line of data after the header it works perfectly.

Here it is:

<sub>'Main Loop
For i = 1 To UBound(campus_array)
unique_cnt = WorksheetFunction.CountIf(Worksheets("Uniques").Range("B2:B65000"), campus_array(i))
ReDim final_combo_array(1 To unique_cnt, 1 To 3)

'Get unique list of programs and lengths
With ActiveWorkbook.Worksheets("Uniques")
Dim last_row_data As Long
last_row_data = .Range("A65000").End(xlUp).Row
For j = 2 To last_row_data
If .Range("B" & j).Value <> campus_array(i) Then
Else
For k = 1 To 3
final_combo_array(WorksheetFunction.CountIf(.Range("B2:B" & j), campus_array(i)), k) = .Cells(j, k + 1)
Next k
End If
Next j
End With

'Start building the "boxes"
With ActiveWorkbook.ActiveSheet
cur_row = .Range("A65000").End(xlUp).Row + 2
spec_last_row = cur_row + 1 + unique_cnt
.Range("A" & cur_row).Value = campus_array(i)
.Range("A" & cur_row + 1).Value = "Program"
.Range("B" & cur_row + 1).Value = "Length"
.Range("C" & cur_row + 1).Value = "Grads"
.Range("D" & cur_row + 1).Value = "Available"
.Range("E" & cur_row + 1).Value = "Placed"
.Range("F" & cur_row + 1).Value = "Unplaced"
.Range("G" & cur_row + 1).Value = "Verif Placed"
.Range("H" & cur_row + 1).Value = "Min Req"
.Range("I" & cur_row + 1).Value = "Target"

For j = 1 To unique_cnt
.Range("A" & cur_row + 1 + j).Value = final_combo_array(j, 2)
.Range("B" & cur_row + 1 + j).Value = final_combo_array(j, 3)
Next j

cur_Region = WorksheetFunction.VLookup(campus_array(i), ActiveWorkbook.Worksheets("Ranges").Range("D2:E100"), 2, False)

'Input the formulas
Call Calc_Orig(cur_Region, cur_row)

If ActiveSheet.Range("A9").Value <> "Nursing" Then
With .Range("C" & cur_row + 2 & ":I" & spec_last_row)
.FillDown
End With
End If

.Range("A" & spec_last_row + 1).Value = "Total"
.Range("C" & spec_last_row + 1).Formula = "=SUM(C$" & cur_row + 2 & ":C$" & spec_last_row & ")"

'Format the "boxes"
Call FormatLoop(ActiveWorkbook.ActiveSheet, cur_row, spec_last_row)

End With
Next i



Sub Calc_Orig(cur_Region As Integer, cur_row As Long)

With ActiveWorkbook.ActiveSheet
Dim rng_Region As String, rng_Prog As String, rng_Length As String, rng_Cnt As String

rng_Length = "(Data!$I$2:$I$65000=$B" & cur_row + 2 & ")*"
rng_Cnt = "(Data!$AN$2:$AN$65000)*"

If cur_Region = 1 Then
rng_Region = "(Data!$F$2:$F$65000=$A$" & cur_row & ")*"
rng_Prog = "(Data!$AJ$2:$AJ$65000=$A" & cur_row + 2 & ")*"
ElseIf cur_Region = 2 Then
rng_Region = "(Data!$AH$2:$AH$65000=$A$" & cur_row & ")*"
rng_Prog = "(Data!$AK$2:$AK$65000=$A" & cur_row + 2 & ")*"
ElseIf cur_Region = 3 Then
rng_Region = "(Data!$AG$2:$AG$65000=$A$" & cur_row & ")*"
rng_Prog = "(Data!$AK$2:$AK$65000=$A" & cur_row + 2 & ")*"
Else
rng_Region = ""
rng_Prog = "(Data!$AK$2:$AK$65000=$A" & cur_row + 2 & ")*"
End If

.Range("C" & cur_row + 2).Formula = "=SUMPRODUCT(" & rng_Region & rng_Prog & rng_Length & rng_Cnt & "(Data!$P$2:$P$65000))"
.Range("D" & cur_row + 2).Formula = "=SUMPRODUCT(" & rng_Region & rng_Prog & rng_Length & rng_Cnt & "(NOT(Data!$Q$2:$Q$65000))*" _
& "(NOT(Data!$R$2:$R$65000))*(Data!$P$2:$P$65000))"
.Range("E" & cur_row + 2).Formula = "=SUMPRODUCT(" & rng_Region & rng_Prog & rng_Length & rng_Cnt & "(Data!$S$2:$S$65000))"
.Range("F" & cur_row + 2).Formula = "=$D" & cur_row + 2 & "- $E" & cur_row + 2
.Range("G" & cur_row + 2).Formula = "=SUMPRODUCT(" & rng_Region & rng_Prog & rng_Length & rng_Cnt & "(Data!$S$2:$S$65000)*" _
& "(Data!$AC$2:$AC$65000))"
.Range("H" & cur_row + 2).Formula = "=IF(IFERROR($E" & cur_row + 2 & "/$D" & cur_row + 2 & ", ""N/A"")=""N/A"",0,ROUNDUP(IF((" _
& "$E" & cur_row + 2 & "/$D" & cur_row + 2 & ")>=.695,0,($D" & cur_row + 2 & "*.695)-$E" & cur_row + 2 & "),0))"
.Range("I" & cur_row + 2).Formula = "=IF(IFERROR($E" & cur_row + 2 & "/$D" & cur_row + 2 & ", ""N/A"")=""N/A"",0,ROUNDUP(IF((" _
& "$E" & cur_row + 2 & "/$D" & cur_row + 2 & ")>=.8,0,($D" & cur_row + 2 & "*.8)-$E" & cur_row + 2 & "),0))"


End With

End Sub</sub>

 

[cmholmes]

I think I need to change the if statement on this section

'
'Input the formulas
Call Calc_Orig(cur_Region, cur_row)

If ActiveSheet.Range("A9").Value <> "Nursing" Then
With .Range("C" & cur_row + 2 & ":I" & spec_last_row)
.FillDown
End With
End If

.Range("A" & spec_last_row + 1).Value = "Total"
.Range("C" & spec_last_row + 1).Formula = "=SUM(C$" & cur_row + 2 & ":C$" & spec_last_row & ")"

'Format the "boxes"
Call FormatLoop(ActiveWorkbook.ActiveSheet, cur_row, spec_last_row)

End With
Next i
'

 

[JackDanIce]

Test the values of variables cur_Row spec_last_row on this line:

With .Range("C" & cur_row + 2 & ":I" & spec_last_row)

See what the actual range is that is being defined by that object, I suspect the +2 is causing an issue or cur_Region is >= spec_last_row

 

[cmholmes]

I figured it out.... I changed the if statement about to

If unique_cnt >1 Then

This worked. Thanks