Modify VBA code

[dmj120]

I'm trying to modify code that bebo021999 helped with here.

The original code works perfectly, but now I'm trying to modify it so I can assign it to a 'button' (ie excel shape) that will look at all cells in the range and update any number to the correct rounding.

I've tried a few variations, and here's where I'm at (the original code after).

Private Sub Rnd()
    Dim Target As Range
    Set Target = ThisWorkbook.Sheets("MS.combined").Range("H6:H25000")
    
    Application.EnableEvents = False
    
    For Each Cell In Target
        If IsNumeric(Cell.Value) And Not IsEmpty(Cell.Value) Then
            Cell.Value = Evaluate("ROUND(" & Cell.Address & "/365,2)*365")
        End If
    Next Cell
    
    Application.EnableEvents = True
End Sub

Original code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Do nothing if range does not change OR text value OR cell is deleted
If Intersect(Target, Range("I2:I6000")) Is Nothing Or _
    Not IsNumeric(Target) Or IsEmpty(Target) Then Exit Sub

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

 

[mohadin]

Hi
Try

Private Sub Rnd()
    Dim Target_ As Range
    Dim cel
    Set Target_ = ThisWorkbook.Sheets("MS.combined").Range("H6:H" & Cells(Rows.Count, "H").End(xlUp).Row)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each cel In Target_
        If IsNumeric(cel) And cel.Value <> "" Then cel.Value = Evaluate("ROUND(" & cel.Address & "/365,2)*365")
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[dmj120]

After pasting this into module 1, when I try to assign the macro the popup window is blank.

What am I doing wrong?

Hi
Try

Private Sub Rnd()
    Dim Target_ As Range
    Dim cel
    Set Target_ = ThisWorkbook.Sheets("MS.combined").Range("H6:H" & Cells(Rows.Count, "H").End(xlUp).Row)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each cel In Target_
        If IsNumeric(cel) And cel.Value <> "" Then cel.Value = Evaluate("ROUND(" & cel.Address & "/365,2)*365")
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[MARK858]

Try removing the word "Private"

 

[mohadin]

Absolutely right MARKS858

Sub Rnd()
    Dim Target_ As Range
    Dim cel
    Set Target_ = ThisWorkbook.Sheets("MS.combined").Range("H6:H" & Cells(Rows.Count, "H").End(xlUp).Row)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each cel In Target_
        If IsNumeric(cel) And cel.Value <> "" Then cel.Value = Evaluate("ROUND(" & cel.Address & "/365,2)*365")
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[dmj120]

Works perfectly, thanks!! Time to read up on why removing private works.

Absolutely right MARKS858

Sub Rnd()
    Dim Target_ As Range
    Dim cel
    Set Target_ = ThisWorkbook.Sheets("MS.combined").Range("H6:H" & Cells(Rows.Count, "H").End(xlUp).Row)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each cel In Target_
        If IsNumeric(cel) And cel.Value <> "" Then cel.Value = Evaluate("ROUND(" & cel.Address & "/365,2)*365")
    Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub