Run Time Error 6 Division by 0 but its not trying to divide by 0

G

Goneill

New Member
Joined
Aug 5, 2014
Messages
16
Hello,

I am very new to writing VBA code.I have the code below and for some reason keep getting run time error 6 "division by 0". The values in the cells i am trying to divide do not have a zero so i am very puzzled. The division by zero error only happens in my "Cloud PBX Voice Services (MRC - Monthly changers)" section. but in the other 4 sections I get a runtime error 11 "overflow" I have searched for days to find why this is happening but have found nothing. Any help is Greatly appriciated.

Also quckly want to add that the macro does actualy perform all the math and place it on the sheet even tho the error is there.

Thanks

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

r = Target.Row
c = Target.Column
Value = ActiveSheet.Cells(r, c)
rw = r
If c = 3 Then
    Exit Sub
End If
If c = 1 Then
    

    If ActiveSheet.Cells(r, c + 1).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c + 1).Interior.Color = 16776961 Then
        
       Sheets("Work Sheet").Cells(r, 7) = Sheets("Work Sheet").Cells(r, 1) * Sheets("Work Sheet").Cells(r, 6)
       Sheets("Work Sheet").Cells(r, 9) = Sheets("Work Sheet").Cells(r, 6) - Sheets("Work Sheet").Cells(r, 8)
       Sheets("Work Sheet").Cells(r, 10) = Sheets("Work Sheet").Cells(r, 9) / Sheets("Work Sheet").Cells(r, 6)
       Call total(rw)
       Call total_chg
    End If

End If

If c = 6 Then

    If ActiveSheet.Cells(r, c - 5).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c - 5).Interior.Color = 16776961 Then
        
       Sheets("Work Sheet").Cells(r, 7) = Sheets("Work Sheet").Cells(r, 1) * Sheets("Work Sheet").Cells(r, 6)
       Sheets("Work Sheet").Cells(r, 9) = Sheets("Work Sheet").Cells(r, 6) - Sheets("Work Sheet").Cells(r, 8)
       Sheets("Work Sheet").Cells(r, 10) = Sheets("Work Sheet").Cells(r, 9) / Sheets("Work Sheet").Cells(r, 6)  'This line is highlighted when i debug
       Call total(rw)
       Call total_chg
    End If

End If

If ActiveSheet.Cells(r, c).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c).Interior.Color = 16776961 Then

    For i = 2 To 100
    
        If ActiveSheet.Cells(r - 1, 1).Interior.Color = 192 Then

            If ActiveSheet.Cells(r - 1, 1) = "Hardware and Software  (NRC / One Time Cost)" Then
                
                sheetname = "Hardware Software"
                
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Cloud PBX Voice Services (NRC / One Time Cost)" Then
            
                sheetname = "Voice Services NRC"
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Cloud PBX Voice Services (MRC - Monthly Charges)" Then
            
                sheetname = "Voice Services MRC"
               
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Professional Services  (NRC / One Time Cost)" Then
            
                sheetname = "professional service"
                
                Exit For
            End If
            If ActiveSheet.Cells(r - 1, 1) = " Service Level Agreement (SLA)  / Maintenance  (NRC / One Time Cost)" Then
            
                sheetname = "SLA_Maint"
                
                Exit For
                
            End If
            
        End If
        r = r - 1
        
    Next

    For j = 2 To 10000
        If Trim(LCase(Sheets(sheetname).Cells(j, 2))) = Trim(LCase(Value)) Then
     
            Sheets("Work Sheet").Cells(rw, 6) = Sheets(sheetname).Cells(j, 8)
            Sheets("Work Sheet").Cells(rw, 3) = Sheets(sheetname).Cells(j, 5)
            Sheets("Work Sheet").Cells(rw, 8) = Sheets(sheetname).Cells(j, 9)
            Sheets("Work Sheet").Cells(rw, 1) = 1
            Sheets("Work Sheet").Cells(rw, 7) = Sheets("Work Sheet").Cells(rw, 1) * Sheets("Work Sheet").Cells(rw, 6)
            Sheets("Work Sheet").Cells(rw, 9) = Sheets("Work Sheet").Cells(rw, 6) - Sheets("Work Sheet").Cells(rw, 8)
            Sheets("Work Sheet").Cells(rw, 10) = Sheets("Work Sheet").Cells(rw, 9) / Sheets("Work Sheet").Cells(rw, 6)
            Sheets("Work Sheet").Rows(rw + 1).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            Exit For
        End If
    
    Next

Call total(rw)
Call total_chg

End If

End Sub
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
the highlighted line is dividing by column 6 of the current row. are you sure that is not zero?
 
Upvote 0
par60056 said:
the highlighted line is dividing by column 6 of the current row. are you sure that is not zero?
Click to expand...

there should always be a value above 0 in column 6. near the bottom of the code you will see that column 6 should be filled in with a value from another sheet based on the value in column 2. there are no associated values of 0 on the other sheets column 8.
 
Upvote 0
but you are filling it in after you divide. The line that is giving the error is not putting a formula in a cell, it is doing the math and putting a value in the cell.
 
Upvote 0
par60056 said:
but you are filling it in after you divide. The line that is giving the error is not putting a formula in a cell, it is doing the math and putting a value in the cell.
Click to expand...

1st off Thanks for the reply and your time. Im not sure i am following. I placed the line of code that is giving the error at the bottom as to be onw of the last things done. Is this what you mean. I am still getting the same errors.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

r = Target.Row
c = Target.Column
Value = ActiveSheet.Cells(r, c)
rw = r
If c = 3 Then
    Exit Sub
End If

If ActiveSheet.Cells(r, c).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c).Interior.Color = 16776961 Then

    For i = 2 To 100
    
        If ActiveSheet.Cells(r - 1, 1).Interior.Color = 192 Then

            If ActiveSheet.Cells(r - 1, 1) = "Hardware and Software  (NRC / One Time Cost)" Then
                
                sheetname = "Hardware Software"
                
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Cloud PBX Voice Services (NRC / One Time Cost)" Then
            
                sheetname = "Voice Services NRC"
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Cloud PBX Voice Services (MRC - Monthly Charges)" Then
            
                sheetname = "Voice Services MRC"
               
                Exit For
                
            End If
            If ActiveSheet.Cells(r - 1, 1) = "Professional Services  (NRC / One Time Cost)" Then
            
                sheetname = "professional service"
                
                Exit For
            End If
            If ActiveSheet.Cells(r - 1, 1) = " Service Level Agreement (SLA)  / Maintenance  (NRC / One Time Cost)" Then
            
                sheetname = "SLA_Maint"
                
                Exit For
                
            End If
            
        End If
        r = r - 1
        
    Next

    For j = 2 To 10000
        If Trim(LCase(Sheets(sheetname).Cells(j, 2))) = Trim(LCase(Value)) Then
     
            Sheets("Work Sheet").Cells(rw, 6) = Sheets(sheetname).Cells(j, 8)
            Sheets("Work Sheet").Cells(rw, 3) = Sheets(sheetname).Cells(j, 5)
            Sheets("Work Sheet").Cells(rw, 8) = Sheets(sheetname).Cells(j, 9)
            Sheets("Work Sheet").Cells(rw, 7) = Sheets("Work Sheet").Cells(rw, 1) * Sheets("Work Sheet").Cells(rw, 6)
            Sheets("Work Sheet").Cells(rw, 9) = Sheets("Work Sheet").Cells(rw, 6) - Sheets("Work Sheet").Cells(rw, 8)
            Sheets("Work Sheet").Cells(rw, 10) = Sheets("Work Sheet").Cells(rw, 9) / Sheets("Work Sheet").Cells(rw, 6)
            Sheets("Work Sheet").Rows(rw + 1).Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            Exit For
        End If
    
    Next

Call total(rw)
Call total_chg

End If
If c = 1 Then
    

    If ActiveSheet.Cells(r, c + 1).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c + 1).Interior.Color = 16776961 Then
        
       Sheets("Work Sheet").Cells(r, 7) = Sheets("Work Sheet").Cells(r, 1) * Sheets("Work Sheet").Cells(r, 6)
       Sheets("Work Sheet").Cells(r, 9) = Sheets("Work Sheet").Cells(r, 6) - Sheets("Work Sheet").Cells(r, 8)
       Sheets("Work Sheet").Cells(r, 10) = Sheets("Work Sheet").Cells(r, 9) / Sheets("Work Sheet").Cells(r, 6)  'Debug brings me to this line
       Call total(rw)
       Call total_chg
    End If

End If

If c = 6 Then

    If ActiveSheet.Cells(r, c - 5).Interior.Color = 16776960 Or ActiveSheet.Cells(r, c - 5).Interior.Color = 16776961 Then
        
       Sheets("Work Sheet").Cells(r, 7) = Sheets("Work Sheet").Cells(r, 1) * Sheets("Work Sheet").Cells(r, 6)
       Sheets("Work Sheet").Cells(r, 9) = Sheets("Work Sheet").Cells(r, 6) - Sheets("Work Sheet").Cells(r, 8)
       Sheets("Work Sheet").Cells(r, 10) = Sheets("Work Sheet").Cells(r, 9) / Sheets("Work Sheet").Cells(r, 6)
       Call total(rw)
       Call total_chg
    End If

End If

End Sub
 
Upvote 0
It would be better there but I see some problems.

if the interior color is 16776960 or 16776961, then the value of r may be modified by the first loop. I don't see the where 'i' is used anywhere in the the loop but I see r=r-1 which will make you lose the row that was changed.


 
Upvote 0
Could the code be calling itself?
 
Upvote 0
I expect so since several places set cell values on activesheet. But it is only going to make changes if it is column 1 or 6 or one of the 2 interior colors. (though the calls to total and total_chg concern me because they could cause endless looping)
 
Upvote 0
Here is the code for total-chg

Code: 
Sub total_chg()
x = 0
Sum = 0
Sum_MRC = 0
Sum_mark = 0
For i = 20 To 1000

    If Trim(Sheets("Work Sheet").Cells(i, 5)) = "Total" Then
        
        Sum_MRC = Sheets("Work sheet").Cells(i, 7)
        Exit For
        
    End If

Next
For i = 20 To 1000

    If Trim(Sheets("Work Sheet").Cells(i, 5)) = "Total" Then
        
        Sum = Sum + Sheets("Work sheet").Cells(i, 7)
        Sum_mark = Sum_mark + Sheets("Work sheet").Cells(i, 9)
        x = x + 1
        
    End If
    If x = 5 Then
        Exit For
    End If

Next

Sheets("Work sheet").Cells(10, 7) = Sum_MRC
Sheets("Work sheet").Cells(11, 7) = Sum - Sum_MRC
Sheets("Work sheet").Cells(15, 6) = Sum_mark
If Sheets("Work sheet").Cells(11, 7) <> 0 Then
    Sheets("Work sheet").Cells(15, 7) = Sum_mark / Sheets("Work sheet").Cells(11, 7)
End If
End Sub

And her is total (rw)

Code: 
Sub total(rw)

Sum_MpA = 0
Sum_ECC = 0
For i = 1 To 100
    If Sheets("Work Sheet").Cells(rw, 3) = "Description" Then
    
        For k = 1 To 100
            rw = rw + 1
            
            Sum_MpA = Sum_MpA + Sheets("Work Sheet").Cells(rw, 9)
            Sum_ECC = Sum_ECC + Sheets("Work Sheet").Cells(rw, 7)
            
            If Sheets("Work Sheet").Cells(rw + 1, 5) = "Total" Then
              
                Sheets("Work Sheet").Cells(rw + 1, 9) = Sum_MpA
                Sheets("Work Sheet").Cells(rw + 1, 7) = Sum_ECC

                Exit Sub
            End If
            
        
        Next
           
    End If
    rw = rw - 1

Next



End Sub

Thanks again for help guys!
 
Upvote 0
ok since neither of those are effecting column 1 or 6, you will probably not have problems caused by reentry to the event procedure.
 
Upvote 0
You must log in or register to reply here.

Similar threads

dreid1011
  • Question Question
Recursive Sub Calls and Stack Overflow
2 3
Replies
21
Views
307
6StringJazzer
6StringJazzer
Z
  • Solved
Code working within a file, giving Error 448 within another file
Replies
2
Views
137
zankzank
Z
I
  • Question Question
Unable to run VBA code
Replies
6
Views
170
RoryA
RoryA
A
  • Solved
Could not set the RowSource property. Invalid property value. Error 380
2
Replies
16
Views
268
RoryA
RoryA
S
  • Question Question
Using VBA to Flag and Calculate Overlapping Shift Times
Replies
0
Views
486
Snort
S

Forum statistics

Threads
1,224,889
Messages
6,181,606
Members
453,055
Latest member
cope7895

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top