cdfj
cdfj

Reputation: 165

Overflow error in VBA calculation (division)

In the macro below I get an Overflow error when calculating Rate = cell.Offset(0, 7).Value / cell.Offset(0, 2).Value - regardless of whether Rate is declared as Long or Double. Kindly help to identify the error.

Sub Apply_ProRata()
Dim DistVal As Integer
Dim Rate As Long
Dim ID As String
Dim cell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Test")

For Each cell In ws.Range("B9:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
    If Len(cell.Value) = 20 Then
        ID = cell.Value
        
        DistVal = cell.Offset(0, 2).Value - cell.Offset(0, 7).Value
        Rate = cell.Offset(0, 7).Value / cell.Offset(0, 2).Value
        
        cell.Offset(0, 13).Value = DistVal
        cell.Offset(0, 14).Value = Format(Rate, "00.0%")
        
        For Each cell2 In ws.Range("B9:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
            If Len(cell2.Value) > 20 And InStr(cell2.Value, ID) = 1 Then
                cell2.Offset(0, 15).Value = cell2.Value / (DistVal * Rate)
            End If
        Next cell2
    End If
Next cell 
End Sub

In natural language the macro is to do:

For each cell in column B where the length of the cell value = 20 characters

Set ID = value in cell in column B

Set value in cell O equal to value in cell D minus value in cell I

Set value in cell P equal to value in cell I divided by value in cell D number formatted as percentage "00.0%"

Set DistVal = value in cell O

Set Rate = value in cell P

For each row in column B if the the length of the cell value > 20 characters and the InStr cell value starts with the ID string

Set value in cell Q equal to the value of cell D divided by (DistVal * Rate)

Next row

Next row

Upvotes: 1

Views: 46

Answers (1)

Michal
Michal

Reputation: 5725

Declaring Rate and DistVal as Double should do the trick.

Sub Apply_ProRata()
    Dim DistVal As Double
    Dim Rate As Double
    Dim ID As String
    Dim cell As Range
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Test")
    
    On Error GoTo ErrorHandler ' Add error handling

    For Each cell In ws.Range("B9:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
        If Len(cell.Value) = 20 Then
            ID = cell.Value
            
            If cell.Offset(0, 2).Value <> 0 Then ' Ensure no division by zero
                DistVal = cell.Offset(0, 2).Value - cell.Offset(0, 7).Value
                Rate = cell.Offset(0, 7).Value / cell.Offset(0, 2).Value
                
                cell.Offset(0, 13).Value = DistVal
                cell.Offset(0, 14).Value = Format(Rate, "00.0%")
                
                For Each cell2 In ws.Range("B9:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
                    If Len(cell2.Value) > 20 And InStr(cell2.Value, ID) = 1 Then
                        cell2.Offset(0, 15).Value = cell2.Value / (DistVal * Rate)
                    End If
                Next cell2
            Else
                cell.Offset(0, 14).Value = "Div/0 Error"
            End If
        End If
    Next cell
    
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
End Sub

Upvotes: 2

Related Questions