Correcting Decimal Error when Exporting from Access to Excel

[cricrazy]

When I export from MS access to Excel using a macro, all the numbers are getting decimal errors like

0.109 => 0.108999997377396
1.253 => 1.25300002098083

The numbers are having long unnecessary decimals.

I already have excel spreadsheet, with all these columns of long decimals. How to correct them?

1) Is there a worksheet function which corrects this decimal errors?
2) Is there a way to correct the macro to correct in while exporting it?

Thanks.

Function Populate(sql As String) As Long

Dim lngRow As Long
Dim rs As ADODB.Recordset

Dim rsDefect As ADODB.Recordset
Dim rsOperator As ADODB.Recordset
Dim rsMaterial As ADODB.Recordset
Dim rsCutterShape As ADODB.Recordset
Dim rsDiameter As ADODB.Recordset
Dim rsLocation As ADODB.Recordset
Dim rsRadius As ADODB.Recordset
Dim rsThickness As ADODB.Recordset

On Error GoTo error

Set rs = New ADODB.Recordset
Set rsDefect = New ADODB.Recordset
Set rsOperator = New ADODB.Recordset
Set rsMaterial = New ADODB.Recordset
Set rsCutterShape = New ADODB.Recordset
Set rsDiameter = New ADODB.Recordset
Set rsLocation = New ADODB.Recordset
Set rsRadius = New ADODB.Recordset
Set rsThickness = New ADODB.Recordset

lngRow = 3
'Set_Connection

rs.Open sql, cn, adOpenDynamic, adLockOptimistic, 1
rsOperator.Open "select * from lkoperator", cn, adOpenDynamic, adLockOptimistic, 1
rsDefect.Open "select * from lkdefect", cn, adOpenDynamic, adLockOptimistic, 1
rsMaterial.Open "select * from lkmaterial", cn, adOpenDynamic, adLockOptimistic, 1
rsCutterShape.Open "select * from lkcuttershape", cn, adOpenDynamic, adLockOptimistic, 1
rsDiameter.Open "select * from lkdiameter", cn, adOpenDynamic, adLockOptimistic, 1
rsLocation.Open "select * from lklocation", cn, adOpenDynamic, adLockOptimistic, 1
rsRadius.Open "select * from lkRadius", cn, adOpenDynamic, adLockOptimistic, 1
rsThickness.Open "select * from lkThickness", cn, adOpenDynamic, adLockOptimistic, 1

ClearSheet
ClearFormula


Do Until rs.EOF
    lngRow = lngRow + 1
    
    rsOperator.MoveFirst
    rsDefect.MoveFirst
    rsMaterial.MoveFirst
    rsCutterShape.MoveFirst
    rsDiameter.MoveFirst
    rsLocation.MoveFirst
    rsRadius.MoveFirst
    rsThickness.MoveFirst
    
    Cells(lngRow, 2).Value = rs![rundate]

    If IsNull(rs![Location]) Then
        Cells(lngRow, 3).Value = rsLocation![Location] = ""
    Else
        rsLocation.Find "locationid = " & rs![Location], , adSearchForward
        Cells(lngRow, 3).Value = rsLocation![Location]
    End If

    If IsNull(rs!rundate) Then
          Cells(lngRow, 1).Value = ""
    Else
          Cells(lngRow, 1).Value = BuildCaseID(rsLocation![Location], rs![rundate], rs!runvalue)
    End If

    Cells(lngRow, 4).Value = rs![runvalue]
    
    If IsNull(rs!OperatorName) Then
        Cells(lngRow, 5).Value = ""
    Else
        rsOperator.Find "operatorid = " & rs!OperatorName, , adSearchForward
        Cells(lngRow, 5).Value = rsOperator!OperatorName
    End If
    
    If IsNull(rs!Material) Then
        Cells(lngRow, 6).Value = ""
    Else
        rsMaterial.Find "materialid = " & rs!Material, , adSearchForward
        Cells(lngRow, 6).Value = rsMaterial!Material
    End If
    
    If IsNull(rs!NominalDiameter) Then
        Cells(lngRow, 7).Value = ""
    Else
        rsDiameter.Find "Diameterid = " & rs!NominalDiameter, , adSearchForward
        Cells(lngRow, 7).Value = rsDiameter!Diameter
    End If

    If IsNull(rs!NominalThickness) Then
        Cells(lngRow, 8).Value = ""
    Else
        rsThickness.Find "Thicknessid = " & rs!NominalThickness, , adSearchForward
        Cells(lngRow, 8).Value = rsThickness!thickness
    End If
    
    If IsNull(rs!radius) Then
        Cells(lngRow, 9).Value = ""
    Else
        rsRadius.Find "Radiusid = " & rs!radius, , adSearchForward
        Cells(lngRow, 9).Value = rsRadius!radius
    End If
    
    Cells(lngRow, 10).Value = rs!PSET
    Cells(lngRow, 11).Value = rs!StringNumber
    Cells(lngRow, 12).Value = rs!NominalYield
    Cells(lngRow, 13).Value = rs!YieldStrength
    Cells(lngRow, 14).Value = rs!TensileStrength
    
    If IsNull(rs!Nb) Then




        Cells(lngRow, 15).Value = 0
    Else
        Cells(lngRow, 15).Value = rs!Nb
    End If
    
    Cells(lngRow, 16).Value = rs!DtcOriginal
    Cells(lngRow, 17).Value = rs!DnaOriginal
    Cells(lngRow, 18).Value = rs!t
    Cells(lngRow, 19).Value = rs!ERWLocation
    Cells(lngRow, 20).Value = rs!NRun
    
    
    Cells(lngRow, 21).Value = rs!LFailure
    Cells(lngRow, 22).Value = rs!ThetaFailure
    Cells(lngRow, 23).Value = rs!DtcFinal
    Cells(lngRow, 24).Value = rs!DnaFinal
    Cells(lngRow, 25).Value = rs!AvgPressure
    
    If IsNull(rs!defecttype) Then
        Cells(lngRow, 26).Value = "N/A"
    Else
        rsDefect.Find "defectid = " & rs!defecttype, , adSearchForward
        Cells(lngRow, 26).Value = rsDefect!Defect
    End If

    
    If IsNull(rs!cuttershape) Or rs!cuttershape = 0 Then
        Cells(lngRow, 27).Value = "N/A"
    Else
        rsCutterShape.Find "cuttershapeid = " & rs!cuttershape, , adSearchForward
        Cells(lngRow, 27).Value = rsCutterShape!cuttershape
    End If
    
    Cells(lngRow, 28).Value = rs!CutterDiameter
    Cells(lngRow, 29).Value = rs!NominalDepth
    Cells(lngRow, 30).Value = rs!MeasuredDepth
    Cells(lngRow, 31).Value = rs!DefectW
    Cells(lngRow, 32).Value = rs!DefectX
    Cells(lngRow, 33).Value = rs!DefectLocationCirc
    Cells(lngRow, 34).Value = rs!DefectLocationODID
    Cells(lngRow, 35).Value = rs!DefectLocationAxial
    
    If IsNull(rs!FailedonDefect) Then
        Cells(lngRow, 36).Value = ""
    ElseIf rs!FailedonDefect Then
        Cells(lngRow, 36).Value = "Yes"
    Else
        Cells(lngRow, 36).Value = "No"
    End If

    rs.MoveNext

Loop

LastLine = lngRow + 1

CompleteFormula
CompleteChart

'FormatSheet

Range("B4").Select
rs.Close
Set rs = Nothing

Populate = 1

Exit Function
error:
Populate = 0
Resume Next
If Err.Number = 3709 Then
    Set_Connection
    Resume
End If



End Function