VBA rounding with formula

[dmj120]

I'm trying to use a snippet of code from a previous post. But when I add this to the sheet, nothing happens. Where's my mistake?

All I'm trying to do is in column I, the amount entered uses the formula = Round(cell.Value / 365, 2) * 365 to calculate when I enter a value.

Option Explicit

Dim rng As Range
Dim cell As Range
   
Set rng = Intersect(Target, Range("I2:I15000"))
   
If Not rng Is Nothing Then

    Application.EnableEvents = False
   
    For Each cell In rng
        If IsNumeric(cell.Value) Then
            cell.Value = Round(cell.Value / 365, 2) * 365
        End If
    Next cell
   
    Application.EnableEvents = True
    
End If

 

[Trebor76]

Hi there,

I take it you only want to change the cell that's just been changed not the entire range each time?

 

[dmj120]

Hi there,

I take it you only want to change the cell that's just been changed not the entire range each time?

Correct.

 

[Trebor76]

Try this event macro on the sheet in question:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ErrTrap

    Dim rng As Range

    Set rng = Intersect(Target, Range("I2:I15000"))

    If Not rng Is Nothing Then

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
       
        Target.Value = Evaluate("ROUND(" & Target.Address & "/365,2)*365")

        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With

    End If

Exit Sub

ErrTrap:

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Regards,

Robert

 

[dmj120]

Try this event macro on the sheet in question:

Regards,

Robert

Thanks, yes that works. If you delete the value, $0 is entered. Is there a way to have the cell 'blank' if you delete the value?

 

[Trebor76]

Is there a way to have the cell 'blank' if you delete the value?

Yes - add this:

If Len(Target) > 0 Then
    Target.Value = Evaluate("ROUND(" & Target.Address & "/365,2)*365")
End If

 

[mmhill]

Add a line to clear the cell.

Target.Value = Evaluate("ROUND(" & Target.Address & "/365,2)*365")
If Target.Value =0 then Target.ClearContents

 

[Trebor76]

Add a line to clear the cell.
VBA Code:
Target.Value = Evaluate("ROUND(" & Target.Address & "/365,2)*365")
If Target.Value =0 then Target.ClearContents

That will clear the cell if the result of the formula equals zero. I could be wrong but I don't think that's what the OP is asking for.

 

[dmj120]

That will clear the cell if the result of the formula equals zero. I could be wrong but I don't think that's what the OP is asking for.

I was hoping to clear the cell. Thanks for your replies!