VBA Code leaves loop early if there is more than 360 rows of data

Question

The code below works fine until more there is more then 360 rows to cycle through. If there are more than 360 rows, nothing after the bottom loop runs. In fact the code stops looping through the top loop on row 361 at the place indicated below.

I changed all row variables from integer to long and played around with the row numbers to narrow down the row number the problem occurs. If I have less than 361 rows, the code runs fine.

Option Explicit
'Process report variables
Dim ProcRowCount As Long
Dim Process As String
Dim ProcSID As String
Dim ProcStat As String
Dim ProcBeg As Date
Dim ScheRow As Long
Dim ProcRow As Long
Dim OffName As String
Dim DueDate As Date
Dim procserv As Integer
'event report variables
Dim SchEvent As String
Dim EventSID As String
Dim EventRow As Long
Dim Event2025 As String
Dim EventOut As String
Dim EventDate As Date
Dim Eventdate2 As Date
Dim EventDue As Date
Dim NameSID As String
Dim AttempDate As Date
Dim AttempDate2 As Date

Public Sub Update_Process()

With ThisWorkbook.Worksheets("Process")
ProcRowCount = Worksheets("Process").Cells(Rows.Count, "a").End(xlUp).Row
ProcRow = 1
DueDate = Date - 30

Worksheets("Dashboard").Range("ag5:ag500").ClearContents
Set Case_Status = Worksheets("Tables").ListObjects("Case_Status")
Set Events = Worksheets("Tables").ListObjects("Events")
Set Occurrence = Worksheets("Tables").ListObjects("Occurrence")


'checks for offender to be in an active status and that the process
'has been in status date for more than 30 days
Do While ProcRow <= ProcRowCount
ProcStat = Worksheets("Process").Cells(ProcRow, "f")

If ProcStat = "txt_supervision_code" Or ProcStat = "" Then
    On Error Resume Next
    ProcRow = ProcRow + 1

ElseIf ProcStat <> "txt_supervision_code" Then
    ProcBeg = Worksheets("Process").Cells(ProcRow, "m")
    Active = Application.WorksheetFunction.VLookup(ProcStat,             Case_Status.Range, 3, False)

    If Active = "No" Then
        ProcRow = ProcRow + 1
    ElseIf ProcBeg < DueDate Then
        ProcSID = Worksheets("Process").Cells(ProcRow, "B")
        Process = Worksheets("Process").Cells(ProcRow, "l")
        OffName = Worksheets("Process").Cells(ProcRow, "c")
        Call EventReview
        ProcRow = ProcRow + 1
    Else: ProcRow = ProcRow + 1
    End If
End If
Loop

End With

Worksheets("Dashboard").Range("BG4") = procserv

End Sub

Private Sub EventReview()
'Loop though 2025 to see if a case audit or offender contact was documented on the case
With ThisWorkbook.Worksheets("2025")
ScheRow = Worksheets("2025").Cells(Rows.Count, "a").End(xlUp).Row
EventRow = 2
EventSID = Worksheets("2025").Cells(EventRow, "a")


Do While EventRow <= ScheRow
    Event2025 = Worksheets("2025").Cells(EventRow, "J")
    EventOut = Worksheets("2025").Cells(EventRow, "Q")
    EventSID = Worksheets("2025").Cells(EventRow, "A")
    EventDue = Worksheets("2025").Cells(EventRow, "O")
    CaseReview = Application.WorksheetFunction.VLookup(Event2025, Events.Range, 3, False)  ***Once on row 361, the loop stops here and goes back to the public sub
    OffenderCon = Application.WorksheetFunction.VLookup(Event2025, Events.Range, 2, False)
    EventOccurred = Application.WorksheetFunction.VLookup(EventOut, Occurrence.Range, 6, False)
    If ProcSID = EventSID And EventOccurred = "Yes" And (CaseReview = "Yes" Or OffenderCon = "Yes") And _
            EventDue > DueDate Then
        EventDate = Worksheets("2025").Cells(EventRow, "o")
        If Event2025 = "Process Service" And Process = "A-Warr" Then
            procserv = procserv + 1
            End If
        If Eventdate2 = "12:00:00 AM" Or Eventdate2 < EventDate Then
            Eventdate2 = EventDate
            EventRow = EventRow + 1
        Else: EventRow = EventRow + 1
            End If
    Else: EventRow = EventRow + 1
        End If


Loop


NameSID = OffName & " " & ProcSID

'loop through pivot table, insert date in offset column

With ThisWorkbook.Worksheets("Dashboard")

Set pvt = Worksheets("Dashboard").PivotTables("ProcessPivot")
Set Rng = pvt.DataBodyRange

    For Each cell In Rng
        If cell = NameSID And Eventdate2 <> "12:00:00 AM" Then
            cell.Offset(0, 5) = Eventdate2
            Eventdate2 = "12:00:00 AM"
        ElseIf cell = NameSID Then
            cell.Offset(0, 5).Value = "Not Reviewed"
        End If

    Next cell

End With
End With

End Sub

The expected results is to return either a date, if there is qualifying one, or "Not Reviewed". The code above doesn't return any error messages. It just leaves the EventReview() sub routine mid-loop if there are more than 360 rows, instead of continuing to the second loop to return the results of the loop.

score 0 · Answer 1 · answered Jul 26 '19 at 20:18

0

I'm guessing you want to change this

ProcRowCount = Worksheets("Process").Cells(Rows.Count, "a").End(xlUp).Row

to this

ProcRowCount = Worksheets("Process").UsedRange.Rows.Count

because you really want the last row and the former goes to the last row and then hits end up, which might go all the way to row 1.

Similarly with this guy

ScheRow = Worksheets("2025").Cells(Rows.Count, "a").End(xlUp).Row

Side note: when you do this

With ThisWorkbook.Worksheets("Process")

as you've done, then you can (and should) do this

.UsedRange.Rows.Count

answered Jul 26 '19 at 20:18

Matt Cremeens

4,951
7
38
67

https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba – AAA Jul 26 '19 at 20:26
Then I suppose change the `xlUp` to `xlDown` (and start with the top row of your range) if you are worried that the `UsedRange` method is unreliable. A quick test will let you know if it's trustworthy or not. – Matt Cremeens Jul 26 '19 at 20:29
The current code consistently provides the correct number of rows and the loop actually runs half way through. Its really weird. I had to shut down excel and restart and the code is working now. I have over a hour trying to figure out what was going on... – MsAgentM Jul 26 '19 at 20:45

VBA Code leaves loop early if there is more than 360 rows of data

1 Answers1