NerishaB
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?
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I wish I were! I've just been doing this a while. :)
ASKER