Why is this for loop producing an overflow?

Question

I'm creating some procedures to generate a report based on some data and user inputs. The code copies the necessary information for the base report, and then I have an additional sheet with time series data that I am trying to add onto the report after it is initially copied.

This section of code is producing an overflow after a few iterations through:

For Each rpt_jobtitle In ws.Range("B2:B" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row)
    For Each rw In col_tsJobs
        If rpt_jobtitle.Value = ts_ws.Cells(rw, 2).Value Then
            If rpt_jobtitle.Offset(0, 1).Value = ts_ws.Cells(rw, 3).Value Then
                If rpt_jobtitle.Offset(0, 2).Value = ts_ws.Cells(rw, 4).Value Then
                    ws.Cells(rpt_jobtitle.row, 13).Value = dict_TSViews.Item(rw)
                    ws.Cells(rpt_jobtitle.row, 14).Value = dict_TSApplicants.Item(rw)
                    ws.Cells(rpt_jobtitle.row, 15).Value = (dict_TSApplicants.Item(rw) / dict_TSViews.Item(rw))
                    ws.Cells(rpt_jobtitle.row, 16).Value = (dict_TSApplicants.Item(rw) / (this.ToDate - this.FromDate))
                    Exit For
                End If
            End If
        End If
    Next rw
Next rpt_jobtitle

For context, it is contained within this class module - the loop is within the InsertTSData() subroutine at the bottom:

Option Explicit

Private Type Reports
    RequisitionNumber As String
    FromDate As Date
    ToDate As Date
    JobTitle As String
    JobLocation As String
    JobCategory As String
    RecruiterName As String
    TSViews As Long
    TSApplicants As Long
End Type
Private this As Reports
Public Property Let RequisitionNumber(ByVal inputValue As String)
    this.RequisitionNumber = inputValue
End Property
Public Property Get RequisitionNumber() As String
    RequisitionNumber = this.RequisitionNumber
End Property

Public Property Let JobTitle(ByVal inputValue As String)
    this.JobTitle = inputValue
End Property
Public Property Get JobTitle() As String
    JobTitle = this.JobTitle
End Property
Public Property Let JobLocation(ByVal inputValue As String)
    this.JobLocation = inputValue
End Property
Public Property Get JobLocation() As String
    JobLocation = this.JobLocation
End Property
Public Property Let JobCategory(ByVal inputValue As String)
    this.JobCategory = inputValue
End Property
Public Property Get JobCategory() As String
    JobCategory = this.JobCategory
End Property
Public Property Let RecruiterName(ByVal inputValue As String)
    this.RecruiterName = inputValue
End Property
Public Property Get RecruiterName() As String
    RecruiterName = this.RecruiterName
End Property
Public Property Get TSViews() As Long
    TSViews = this.TSViews
End Property
Public Property Get TSApplicants() As Long
    TSApplicants = this.TSApplicants
End Property
Public Property Get FromDate() As String
    FromDate = this.FromDate
End Property
Public Property Let FromDate(ByVal inputValue As String)
    this.FromDate = inputValue
End Property
Public Property Get ToDate() As String
    ToDate = this.ToDate
End Property
Public Property Let ToDate(ByVal inputValue As String)
    this.ToDate = inputValue
End Property


Private Function DateRange() As Variant
    Dim postcell As Range
    Dim pausecell As Range
    Dim unpausecell As Range
    Dim closecell As Range
    Dim arr_validRows() As Variant
    Dim ws As Worksheet

    Set ws = Sheets(1)

    ReDim arr_validRows(0) As Variant
    Dim z As Range
    For Each z In ws.Range("D3:D" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row)
        Set postcell = z
        Set pausecell = z.Offset(0, 1)
        Set unpausecell = z.Offset(0, 2)
        Set closecell = z.Offset(0, 3)

        If Not closecell.Value = "?" Then
            If CDate(postcell.Value) <= this.ToDate Then
                If Not pausecell.Value = "" Then
                    If CDate(pausecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    ElseIf CDate(pausecell.Value) < this.FromDate And CDate(unpausecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    End If
                Else
                    If CDate(closecell.Value) >= this.FromDate Then

                        ReDim Preserve arr_validRows(UBound(arr_validRows) + 1) As Variant
                        arr_validRows(UBound(arr_validRows)) = z.row

                    End If
                End If
            End If
        End If
    Next z

    DateRange = arr_validRows
End Function

Sub AddToReport(ByVal sheetname As String)
    Dim ws As Worksheet
    Dim newrow As Long
    Set ws = Worksheets("Metric")

    Dim exists As Boolean
    exists = False

    Dim i As Integer
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = sheetname Then
            exists = True
         End If
    Next i

    If Not exists Then
        Call CreateSheet(sheetname)

        With ThisWorkbook.Worksheets(sheetname)
            .Range("1:1").Value = ws.Range("1:1").Value
        End With
    End If


    Dim array_rows() As Variant
    array_rows = DateRange()

    Dim z As Variant
    Dim w As Integer

    With ThisWorkbook.Worksheets(sheetname)
        newrow = .Cells(.Rows.Count, 2).End(xlUp).row

        For z = 1 To UBound(array_rows)
            newrow = newrow + 1

            .Range(newrow & ":" & newrow).Value = ws.Range(array_rows(z) & ":" & array_rows(z)).Value
         Next z
    End With
End Sub

Sub TimeSeriesSummation(ByVal sheetname As String)
    Dim ts_wkst As Worksheet
    Dim rpt_wkst As Worksheet
    Dim dateRow As Range
    Dim jobTitleColumn As Range
    Dim validDates As Collection
    Dim validJobs As Collection
    Dim reportJobTitleColumn As Range
    Dim lastColumn As Variant


    Set rpt_wkst = ThisWorkbook.Worksheets(sheetname)
    Set ts_wkst = ThisWorkbook.Worksheets("Time Series Data")

    lastColumn = ts_wkst.Cells(1, ts_wkst.Columns.Count).End(xlToLeft).Address(RowAbsolute:=False, ColumnAbsolute:=False)

    Set dateRow = ts_wkst.Range("A1:" & lastColumn)
    Set jobTitleColumn = ts_wkst.Range("B3:B" & ts_wkst.Cells(ts_wkst.Rows.Count, 2).End(xlUp).row)
    Set reportJobTitleColumn = rpt_wkst.Range("B3:B" & rpt_wkst.Cells(rpt_wkst.Rows.Count, 2).End(xlUp).row)

    Dim cellDate As Range
    Dim potValidDate As Date
    Set validDates = New Collection

    For Each cellDate In dateRow
        Debug.Print cellDate.Address
        Debug.Print cellDate.Text
        If Not cellDate.Text = "" Then
            Debug.Print cellDate.Address
            Debug.Print cellDate.Text
            potValidDate = CDate(cellDate.Text)
            If potValidDate <= this.ToDate Then
                If potValidDate >= this.FromDate Then
                    'Add to an array/collection of stuff
                    validDates.Add cellDate.column
                    Debug.Print validDates.Item(validDates.Count)
                End If
            End If
        End If
    Next cellDate

    Dim reportJobTitle As Range
    Dim cellJobTitle As Range
    Set validJobs = New Collection

    For Each reportJobTitle In reportJobTitleColumn
        For Each cellJobTitle In jobTitleColumn
            If Not cellJobTitle.Value = "" Then
                If cellJobTitle.Value = reportJobTitle.Value Then
                    If cellJobTitle.Offset(0, 1).Value = reportJobTitle.Offset(0, 1).Value Then
                        If cellJobTitle.Offset(0, 2).Value = reportJobTitle.Offset(0, 2).Value Then
                            'valid row
                            validJobs.Add cellJobTitle.row
                            Debug.Print validJobs.Item(validJobs.Count)
                            Exit For
                        End If
                    End If
                End If
             End If
        Next cellJobTitle
    Next reportJobTitle


    Dim rw As Variant
    Dim col As Variant
    Dim rangeViews As Scripting.Dictionary
    Dim rangeApps As Scripting.Dictionary
    Dim tempTotalViews As Long
    Dim tempTotalApps As Long

    Set rangeViews = New Scripting.Dictionary
    Set rangeApps = New Scripting.Dictionary

    tempTotalViews = 0
    tempTotalApps = 0
    For Each rw In validJobs
        Debug.Print ts_wkst.Cells(rw, 2).Value & ":"

        For Each col In validDates

            tempTotalViews = tempTotalViews + ts_wkst.Cells(rw, col).Value

            Debug.Print "Running Total (V):" & tempTotalViews

            tempTotalApps = tempTotalApps + ts_wkst.Cells(rw, col + 1).Value

            Debug.Print "Running Total (A):" & tempTotalApps
        Next col

        rangeViews.Add rw, tempTotalViews
        rangeApps.Add rw, tempTotalApps
        tempTotalViews = 0
        tempTotalApps = 0
    Next rw

    For Each rw In validJobs
        Debug.Print "Views:" & rangeViews.Item(rw)
        Debug.Print "Apps:" & rangeApps.Item(rw)
    Next rw

    Call InsertTSData(sheetname, validJobs, rangeViews, rangeApps)

    rangeViews.RemoveAll
    rangeApps.RemoveAll



End Sub

Sub AdvancedFilters( _
    ByVal reqnum_on As Boolean, _
    ByVal jobcategory_on As Boolean, _
    ByVal recruiter_on As Boolean, _
    ByVal jobtitle_on As Boolean, _
    ByVal joblocation_on As Boolean, _
    ByVal sheetname As String)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(sheetname)

    With ws.Range("A:O")
        ws.AutoFilterMode = False
        If reqnum_on Then
            'field 1
            .AutoFilter field:=1, Criteria1:="<>" & this.RequisitionNumber
        End If

        If jobcategory_on Then
            'field 13
            .AutoFilter field:=13, Criteria1:="<>" & this.JobCategory
        End If

        If recruiter_on Then
            'field 14
            .AutoFilter field:=14, Criteria1:="<>" & this.RecruiterName
        End If

        If jobtitle_on Then
            'field 2
            .AutoFilter field:=2, Criteria1:="<>" & this.JobTitle
        End If

        If joblocation_on Then
            'field 3
            .AutoFilter field:=3, Criteria1:="<>" & this.JobLocation
        End If
    End With

    If reqnum_on Or jobcategory_on Or recruiter_on Or jobtitle_on Or joblocation_on Then
        ws.Range("B2:B" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        ws.AutoFilterMode = False
    End If

End Sub

Private Sub CreateSheet(ByVal sheetname As String)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = sheetname
End Sub

Sub Statistics(ByVal sheetname As String)
    With ThisWorkbook.Worksheets(sheetname)
        .Range("Q3").Value = "Descriptive Statistics"
        .Range("Q4").Value = "Mean"
        .Range("Q5").Value = "Median"
        .Range("Q6").Value = "Std. Dev."
        .Range("Q7").Value = "Variance"

        .Range("R3").Value = "Total Days Active"
        .Range("S3").Value = "Views"
        .Range("T3").Value = "Applications"
        .Range("U3").Value = "Views-To-Applications"
        .Range("V3").Value = "Applications per Day"

        .Range("R4").Value = "=AVERAGE(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R5").Value = "=MEDIAN(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R6").Value = "=STDEVP(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"
        .Range("R7").Value = "=VARP(H$2:H$" & .Cells(.Rows.Count, 2).End(xlUp).row & ")"

        Dim sourceRange As Range
        Dim fillRange As Range
        Set sourceRange = .Range("R4:R7")
        Set fillRange = .Range("R4:V7")

        Call sourceRange.AutoFill(fillRange)

        .Range("R4:R7").NumberFormat = "0.00"
        .Range("S4:S7").NumberFormat = "0.00"
        .Range("T4:T7").NumberFormat = "0.00"
        .Range("U4:U7").NumberFormat = "0.00%"
        .Range("V4:V7").NumberFormat = "0.00"


    End With
End Sub

Sub FormatColumns(ByVal sheetname As String)
    With ThisWorkbook.Worksheets(sheetname)
        .Range("H:H").NumberFormat = "0.00"
        .Range("I:I").NumberFormat = "0"
        .Range("J:J").NumberFormat = "0"
        .Range("K:K").NumberFormat = "0.00%"
        .Range("L:L").NumberFormat = "0.00"

        .Columns("Q:W").EntireColumn.AutoFit
        .Columns("A:N").EntireColumn.AutoFit
        .Columns("E:G").EntireColumn.Hidden = True
    End With
End Sub

Sub InsertTSData(ByRef sheetname As String, _
    ByRef col_tsJobs As Collection, _
    ByRef dict_TSViews As Scripting.Dictionary, _
    ByRef dict_TSApplicants As Scripting.Dictionary)

    'Add new columns
    Dim ws As Worksheet
    Dim ts_ws As Worksheet
    Dim date_range As String
    Dim rw As Variant
    Dim rpt_jobtitle As Range

    Set ts_ws = ThisWorkbook.Worksheets("Time Series Data")
    Set ws = ThisWorkbook.Worksheets(sheetname)
    date_range = Format(this.FromDate, "mmm d") & " to " & Format(this.ToDate, "mmm d")

    With ws
        .Range("M:P").EntireColumn.Insert
        .Range("M1").Value = date_range & " Views" 'CI 13
        .Range("N1").Value = date_range & " Applicants" 'CI 14
        .Range("O1").Value = date_range & " Views-Apps Conversion" 'CI15
        .Range("P1").Value = date_range & " Apps/Day" 'CI16
    End With

    For Each rpt_jobtitle In ws.Range("B2:B" & ws.Cells(ws.Rows.Count, 2).End(xlUp).row)
        For Each rw In col_tsJobs
            If rpt_jobtitle.Value = ts_ws.Cells(rw, 2).Value Then
                If rpt_jobtitle.Offset(0, 1).Value = ts_ws.Cells(rw, 3).Value Then
                    If rpt_jobtitle.Offset(0, 2).Value = ts_ws.Cells(rw, 4).Value Then
                        ws.Cells(rpt_jobtitle.row, 13).Value = dict_TSViews.Item(rw)
                        ws.Cells(rpt_jobtitle.row, 14).Value = dict_TSApplicants.Item(rw)
                        ws.Cells(rpt_jobtitle.row, 15).Value = (dict_TSApplicants.Item(rw) / dict_TSViews.Item(rw))
                        ws.Cells(rpt_jobtitle.row, 16).Value = (dict_TSApplicants.Item(rw) / (this.ToDate - this.FromDate))
                        Exit For
                    End If
                End If
            End If
        Next rw
    Next rpt_jobtitle

End Sub

What's the typename(dict_TSApplicants.Item(rw))? Could be something like this: msdn.microsoft.com/en-us/library/aa264525(v=vs.60).aspx — Ryan Wildry
– Ryan Wildry, Commented Aug 5, 2016 at 17:07
What value does it return? Debug.print dict_TSApplicants.Item(rw). Same question for dict_TSViews.Item(rw) and (this.ToDate - this.FromDate). — Ryan Wildry
– Ryan Wildry, Commented Aug 5, 2016 at 17:15
@RyanWildry Sales Representatives - Career Fairs - Thursday's in August Views: 2 Applicants: 0 Applicants/Views: 0 Applicants/ToDate-FromDate: 0 Sales Representative (Timeshare Sales) Views: 5 Applicants: 0 Applicants/Views: 0 Applicants/ToDate-FromDate: 0 Restaurant Manager Views: 0 Applicants: 0 Seems like it was a divide by zero error: Views/Applicants on Restaurant Manager is where it hit the overflow error. — Brad Johansen
– Brad Johansen, Commented Aug 5, 2016 at 17:22

cyboashu · Accepted Answer · 2016-08-05 17:30:01Z

2

In these two lines

  ws.Cells(rpt_jobtitle.row, 15).Value = (dict_TSApplicants.Item(rw) / dict_TSViews.Item(rw))
 ws.Cells(rpt_jobtitle.row, 16).Value = (dict_TSApplicants.Item(rw) / (this.ToDate - this.FromDate))

after dict_TSApplicants.Item(rw) return 0 , either dict_TSViews.Item(rw)) evaluates to 0 or (this.ToDate - this.FromDate)evaluates to 0.

Not related to the issue, but using this as a variable name is bit confusing. That's my personal opinion.

0/0 is Oveflow Exception.

edited Aug 5, 2016 at 17:30

answered Aug 5, 2016 at 17:04

cyboashu

10.5k2 gold badges32 silver badges48 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

Ryan Wildry Over a year ago

This would result in a divide by zero error Err.Number 11, not an overflow error.

Comintern Over a year ago

Agreed on using this. I pointed that out a couple days ago.

Brad Johansen Over a year ago

Why would that cause an overflow?

Brad Johansen Over a year ago

@Comintern Yes, and thank you for that. I only recently learned about using class modules and the first tutorial I went through setup their class module in that way. I'm going to try and understand the class module structure/idea before I change that.

cyboashu Over a year ago

when you divide 0 by 0 you get overflow. 0/0 is Overflow.

|

Graham · Accepted Answer · 2017-09-21 22:40:28Z

0

The error is here:

(dict_TSApplicants.Item(rw) / (this.ToDate - this.FromDate))

Date variables in VBA are stored as a doubles with the integer portion the date and the decimal portion the time.

If the ToDate and FromDate are on the same day, subtracting them leaves only a decimal. Dividing by that is the same as multiplying... so you get an overflow:

Dim OneSecond As Date
OneSecond = TimeSerial(12, 0, 1) - TimeSerial(12, 0, 2)
Debug.Print CDbl(OneSecond)            '-1.15740740741499E-05
Debug.Print CDbl(1 / CDbl(OneSecond))  '<-- multiplies by -86399.999999434

edited Sep 21, 2017 at 22:40

Graham

7,86020 gold badges67 silver badges92 bronze badges

answered Aug 5, 2016 at 17:19

Comintern

22.3k6 gold badges36 silver badges83 bronze badges

2 Comments

Brad Johansen Over a year ago

If I do CLng(this.ToDate) - CLng(this.FromDate) would that solve the issue?

Comintern Over a year ago

@RollTideBrad - The overflow issue, yes. But in that case you would also need to test that you aren't dividing by 0.

Collectives™ on Stack Overflow

Why is this for loop producing an overflow?

2 Answers 2

9 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related