Truncate the input numbers in Excel

Question

I use VBA code to truncate the input numbers in Excel.

In some cases it rounds the number rather than truncating.
Examples: 1.11116, 17.84116.

The code is being applied to empty cells where an operator would enter data. That's why I can't use trunc(A1,4) or similar commands.

These are the only numbers I came across the code does not work on. Both end with a 6, but there is no pattern.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const TARGET_RANGE As String = "A1:A10"
    Const DECIMAL_PLACES As Long = 5
    On Error GoTo ClearError
    Dim irg As Range: Set irg = Interesect(Me.Range(TARGET_RANGE),Target)
    If irg Is Nothing Then Exit Sub
    Dim Num As Long: Num = 10^DECIMAL_PLACES
    Application.EnableEvents = False
    Dim iCell As Range, iValue, dValue As Double

    For Each iCell In irg.Cells
        iValue=iCell.Value
        If VarType(iValue)=vbDouble Then
            dValue=Int(iValue * Num)/Num
            If dValue<iValue Then
                iCell.Value=dValue
            End If
        End If
    Next iCell

    ProcExit:
        On Error Resume Next
        If Not Application.EnbaleEvents Then Application.EnableEvents = True
        On Error GoTo O
        Exit Sub

    ClearError:
        Resume ProcExit
End Sub

Answer 1

Use WorksheetFunction.FLOOR(1.11116,0.0001) --> 1.1111

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Const TARGET_RANGE As String = "A1:A10"
  Const DECIMAL_PLACES As Double = 0.00001
  On Error GoTo ClearError
  Dim irg As Range
  Set irg = Interesect(Me.Range(TARGET_RANGE), Target)
  If irg Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Dim iCell As Range, iValue as Variant
  For Each iCell In irg.Cells
    iValue = iCell.Value
    If VarType(iValue) = vbDouble Then
      iCell.Value = WorksheetFunction.FLOOR(iValue, DECIMAL_PLACES)
    End If
  Next iCell
ProcExit:
  On Error Resume Next
  If Not Application.EnbaleEvents Then Application.EnableEvents = True
  Exit Sub
ClearError:
  Resume ProcExit
End Sub