Link to home
Start Free TrialLog in
Avatar of NerishaB
NerishaBFlag for South Africa

asked on

VBA - runtime error 6 - Overflow

Hi,

I have created a report that should print out all of the outstanding balances for all clients.  Now, my query result produces 1080 rows, and I would like those rows displayed on my sheet, but I get the following error:  Runtime Error 6 - Overflow.

See code attached:

Can anyone help?
Private Sub ExtractData(options As CitizenBalanceOpt)
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim ToDate As Date
    Dim FromDate As Date
    Dim AsAtDate As Date
    Dim rng As Range
    Dim i As Integer, j As Integer
    Dim lTotal As Boolean
    Dim firstRow As Boolean
    Dim cStatus As String
    Dim valueCheck As Integer
    Dim totMonths As Integer
    Dim TotalVal As Integer
    Dim RemainMonths As Integer
    Dim TotPaid As Integer
    Dim ValRemaining As Integer
    
    application.StatusBar = "Connecting to Server..."
    
    Set cn = ozConnection()
    Set rs = New ADODB.Recordset

    Range("CitizenBalanceReport!CBReportOptions").value = "As At: " & Format(options.asAt, "dd MMM yyyy")
    Range("CitizenBalanceReport!CBAsAt").value = options.asAt
    
    Call ActiveSheet.Cells.Replace("<Date>", options.drawDate, xlPart, , False)

    application.StatusBar = "Connected. Retrieving records..."
    AsAtDate = options.asAt
    
        sql = _
            "SELECT Con.ContractID, Con.CustomerID, Con.FromDate, Con.ToDateContracted, " & _
            "Con.AmountExcl, C.CustomerRef, C.Name " & _
            "FROM Contracts Con, Customers C " & _
            "WHERE Con.CustomerID = C.CustomerID AND Con.ToDateContracted >= " & ToSql(AsAtDate) & _
            " AND Con.AmountExcl > 0 GROUP BY C.CustomerRef"
        rs.Open sql, cn
        
    Set rng = Range("CitizenBalanceReport!CBBody").Cells(1)
    i = 0: j = 0: valueCheck = 0
    cStatus = ""
    lTotal = False
    firstRow = True
    
    Do While Not rs.EOF
        If firstRow Then
         If Not IsNull(rs!ToDateContracted) Then
           ToDate = rs!ToDateContracted
           FromDate = rs!FromDate
             totMonths = DateDiff("m", FromDate, ToDate)
             RemainMonths = DateDiff("m", FromDate, AsAtDate)
             If RemainMonths > 0 Then
             If totMonths <> 0 Then
              TotalVal = rs!AmountExcl * totMonths
              TotPaid = rs!AmountExcl * RemainMonths
             End If
             End If
             ValRemaining = TotalVal - TotPaid
             rng.Offset(i, 0) = rs!CustomerRef
             rng.Offset(i, 1) = "" & rs!name
             End If
        End If
        
        rng.Offset(i, 4) = rng.Offset(i, 4) + ValRemaining
        
        If rng.Offset(i, valueCheck).value = 0 Then
            rng.Offset(i, valueCheck).value = ""
        End If
        
        rs.MoveNext
        
        If Not rs.EOF Then
            If Not (rs!CustomerRef = rng.Offset(i, 0).value) Then
                i = i + 1
               rng.Offset(i).EntireRow.insert (xlShiftDown)
               firstRow = True
            Else
                firstRow = False
            End If
        End If
    Loop
    
    application.StatusBar = ""

    ' Closes the table.
    rs.Close
    cn.Close ' to drop temp tables...
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of NerishaB

ASKER

Thanks. You're brilliant!!!
I wish I were! I've just been doing this a while. :)