VBA User Defined Function to display 1/8th inch shows up blank

Viewed 50

I'm very new to VBA. I wrote this UDF (my first proper bit of coding) and I'm screwing something up, but I don't know what. I know very little and am currently taking a course, but most answers seem interchangeable to my uneducated eyes.

Also, if anyone has any tips on reducing numbers of variables or cleaning up code in general, I would greatly appreciate it.

Function NearestEighth(number) As String
Dim NE As String

WholeNum = Application.WorksheetFunction.RoundDown(number, 0)
DecNum = (number) - (WholeNum)

    Near = Round(DecNum * 8, 0) / 8

Select Case Near

Case Is = 0
NE = ""

Case Is = 0.125
NE = "1/8"

Case Is = 0.25
NE = "1/4"

Case Is = 0.375
NE = "3/8"

Case Is = 0.5
NE = "1/2"

Case Is = 0.625
NE = "5/8"

Case Is = 0.75
NE = "3/4"

Case Is = 0.875
NE = "7/8"

End Select

Prelim = (number)

Select Case Prelim
    
    Case Prelim > 0 And Prelim < 1
    FractionFormat = NE
    
    Case Prelim > 1
    FractionFormat = (WholeNum) & "-" & (NE)
    
End Select

NearestEighth = FractionFormat

End Function
3 Answers

Consider:

Public Function NearestEighth(number As Double) As String
    Dim wf As WorksheetFunction, n8 As Double
    Set wf = Application.WorksheetFunction
    
    n8 = wf.Round(number * 8, 0) / 8
    
    NearestEighth = wf.Text(n8, "# -?/8")
End Function

enter image description here

Select..Case can only be used for distinct cases, and not a continuous range.

Use If instead to replace Select Case Prelim.. End Select:

If Prelim > 0 And Prelim < 1 Then
    FractionFormat = NE
ElseIf Prelim > 1 Then 
    FractionFormat = (WholeNum) & "-" & (NE)
End If

Write entire dataset using spill range (MS365)

Using MS 365 you could even call a procedure to write values all at once using a so called spill range (e.g. "B1#") to reference the dynamic target:

Option Explicit

Sub ShowNearestEighths()
With Sheet1                  ' referencing the project's worksheet by Code(Name)
    Dim lastRow As Long
    lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    'calculate nearest eighths
    .Range("B1").Formula2 = "=Round(A1:A" & lastRow & " * 8, 0) / 8"
    'use spill range to format
    .Range("B1#").NumberFormat = "# -?/8"
End With
End Sub

Related