How to do a special type of rounding in excel/vba

Question

I have to do a special type of rounding in excel for my school project.

If the number is bigger than #.5 I have to round it up. If the number is equal to #.5 I have to round it to the nearest even number. If the number is less the #.5 I have to round it down.

I hope somebody is able to help me.

Dim getal As Decimal = Nothing
    Console.WriteLine("voer een nummer in")
    getal = Console.ReadLine()

    Dim dec As Integer = Nothing
    Console.WriteLine("voer het aantal deciale in")
    dec = Console.ReadLine()

    Dim factor As Integer = 0
    Dim floor As Decimal = 0
    Dim decimaal As Decimal = 0
    Dim antwoord As Decimal = 0
    Dim percentage As Decimal = 0
    Dim GetalTimesFactor As Decimal = 0
    Dim OnNoukeurigheid As Decimal = 0
    Dim VerFactor As Integer = 0
    Dim HasFactor As Boolean = False
    Dim notation As String = Nothing
    Dim RoundUp As Decimal = 0

    If getal > 1000 Then
        While getal > 10
            getal = getal / 10
            VerFactor = VerFactor + 1
            HasFactor = True
        End While
        Console.WriteLine("getal: " & getal)


    End If

    If getal < 0.0001 Then
        While getal < 1
            getal = getal * 10
            VerFactor = VerFactor - 1
            HasFactor = True
        End While
    End If

    Select Case dec
        Case 0
            factor = 1
            OnNoukeurigheid = 0.5
            RoundUp = 1
        Case 1
            factor = 10
            OnNoukeurigheid = 0.05
            RoundUp = 0.1
        Case 2
            factor = 100
            OnNoukeurigheid = 0.005
            RoundUp = 0.01
        Case 3
            factor = 1000
            OnNoukeurigheid = 0.0005
            RoundUp = 0.001
    End Select

    GetalTimesFactor = getal * factor
    floor = Decimal.Floor(GetalTimesFactor)
    floor = floor / factor
    decimaal = getal - floor
    Console.WriteLine("floor: " & floor)

    If decimaal > OnNoukeurigheid Then
        floor = floor * factor
        antwoord = floor + 1
        antwoord = antwoord / factor
    ElseIf decimaal = OnNoukeurigheid Then
        antwoord = Decimal.Round(getal, dec, MidpointRounding.ToEven)
    Else
        Console.WriteLine("decimaal: " & decimaal)
        Console.WriteLine("getal: " & getal)
        percentage = (decimaal / getal) * 100
        If percentage < 5 Then
            Console.WriteLine("percentage is: " & Decimal.Round(percentage, 1) & "%")
            antwoord = floor
        Else
            Console.WriteLine("percentage is: " & Decimal.Round(percentage, 1) & "%")
            antwoord = floor + RoundUp
        End If
    End If

    If HasFactor Then
        notation = "E" & Format(VerFactor, "00")
    End If

    Console.WriteLine(antwoord & notation)
    Console.ReadLine()

this is what i have made in express it does work but it doesn't work in macro

note: sorry for the dutch varables

Answer 1

I am a little unsure if this is what you were looking for as in your description you seem to imply looking for only whole numbers as results, so I left out a second variable for the function for the inclusion of additional decimal points to keep it simple. I think I interpreted your rounding a little differently than the previous answer, such that in the case of .5 you would opt to round to whichever whole # is even (not sure why this would be the case but if it were here you go!).

I apologize for my sloppy formatting... I am a self taught VBA user so there may be a more efficient way:

Function CustomRound(N As Double)
    If N - Application.WorksheetFunction.RoundDown(N, 0) = 0.5 Then
        If Application.WorksheetFunction.RoundDown(N, 0) Mod 2 = 0 Then
         CustomRound = Application.WorksheetFunction.RoundDown(N, 0)
        Else
         CustomRound = Application.WorksheetFunction.RoundUp(N, 0)
        End If    
    Else
         CustomRound = Round(N, 0)
    End If   
End Function

Answer 2

In VBA it is quite simple, since the VBA Round function does that kind of Rounding:

Function VBARound(N As Double, Optional NumPlaces As Long = 0) As Double
    VBARound = Round(N, NumPlaces)
End Function

The NUMPLACES will allow you to optionally round to other than a whole number.