Excel data being rounded when sent to Access

[Kaelen]

Hey there. So I have a VBA script that sends data from an excel form to an access database. It puts the value from the cell into a double variable (to maintain the decimals) and then uses the following code to send it to access. For some reason though it rounds them all to the nearest integer in the process. Can't really figure out why. Anyone know how to preserve those decimals?

    Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
    Set oDAO = New DAO.DBEngine
    Set oDB = oDAO.OpenDatabase(DBPath)
    Set oRS = oDB.OpenRecordset("Stack Heights")

    oRS.Fields("MHeatPackTop") = MHeatPackTop
    oRS.Fields("MHeatPackCenter12") = MHeatPackCenter12
    oRS.Fields("MHeatPackCenter3") = MHeatPackCenter3
    oRS.Fields("MHeatPackCenter6") = MHeatPackCenter6
    oRS.Fields("MHeatPackCenter9") = MHeatPackCenter9
    oRS.Fields("MSusceptor12") = MSusceptor12
    oRS.Fields("MSusceptor3") = MSusceptor3
    oRS.Fields("MSusceptor6") = MSusceptor6
    oRS.Fields("MSusceptor9") = MSusceptor9

 

[Kaelen]

bump

 

[Joe4]

I don't really see it being sent to Access by the section of code you posted. I see no reference to Access at all in that code.
Are you sending the data to a table in Access?
If so, what is the Data Type of the field in the Access table you are sending it to?

 

[Kaelen]

Should have made it more clear. DBPath is a string variable with the file path of the access database and "Stack Heights" in the next line down is the table name that these are going into. The data type for these fields in access are all set to number and set to 3 decimal places. When the data comes in though it is just the rounded value with 3 zeros after it.

 

[Joe4]

I think we are going to need a lot more information (including the rest of your code), and some sample data.

BTW, have you considered replacing your Excel form with an Access form (since the data is going into Access anyway)?

 

[Kaelen]

Here is the complete code with irrelevant bits cut out. I thought about using an access form but the form does much more than simply take in data and I am not really comfortable enough in access to know whether or not it can do all that I need it to.

As far as sample data: All the variables starting with "M" are length measurements so should all be things like 6.25 or 20.7. I stepped through the code and they are getting recorded to the variables correctly, but when the code tells the access table that the field value should be equal to one of the variables, it gets rounded. For example: If the value of row 18, column 4 is 3.75; then the variable MHeatPackTop will get set to 3.75. But when oRS.Fields("MHeatPackTop") is set to be equal to the variable MHeatPackTop, what actually gets recorded is 4.000.

Private Sub Sumbit_Data_Click()
    
    answer = MsgBox("Are you sure you want to submit this record?", vbYesNo)
    
    If answer = vbNo Then Exit Sub
    
    Set Home = Worksheets("START HERE")
    
    'entry check
    [I]Bunch of if statements that cancel the script if they entered the data incorrectly.[/I]
    
    'declarations
    Dim DBPath As String
    DBPath = "\\pdxfs01\RunFolders\Stack Entry\StackDB.accdb"
    
    Dim Grower As Integer
    Dim Run As Integer
    Dim Timestamp As Date
    Dim Initials As String
    Dim Assembly As String
    Dim TurnType As String
    Dim CrucibleSetup As String
    Dim MLowerSupportPlateOut As Double
    Dim MLowerSupportPlateIn As Double
    Dim MHeatPackTop As Double
    Dim MHeatPackCenter12 As Double
    Dim MHeatPackCenter3 As Double
    Dim MHeatPackCenter6 As Double
    Dim MHeatPackCenter9 As Double
    Dim MSusceptor12 As Double
    Dim MSusceptor3 As Double
    Dim MSusceptor6 As Double
    Dim MSusceptor9 As Double
    Dim MOuterCrucible As Double
    Dim MMiddleCrucible As Double
    Dim MInnerCrucible As Double
    Dim MConeBottom As Double
    Dim MConeCenter12 As Double
    Dim MConeCenter3 As Double
    Dim MConeCenter6 As Double
    Dim MConeCenter9 As Double
    Dim MFeedTubeStand As Double
    Dim Drawing As String
    Dim Description As String
    Dim QtyReplaced As String
    Dim Comment As String
    
    'input to variables
    Grower = Right(Home.Cells(1, 2).Value, 2)
    Run = Home.Cells(2, 2).Value
    Timestamp = Home.Cells(3, 2).Value
    Initials = Home.Cells(4, 2).Value
    Assembly = Home.Cells(5, 2).Value
    If Home.Cells(1, 20).Value = 1 Then
        TurnType = "Full Rebuild"
    ElseIf Home.Cells(1, 20).Value = 2 Then
        TurnType = "Standard Turn"
    End If
    If Home.Cells(2, 20).Value = 1 Then
        CrucibleSetup = "Small Melt Mass"
    ElseIf Home.Cells(2, 20).Value = 2 Then
        CrucibleSetup = "Large Melt Mass"
    ElseIf Home.Cells(2, 20).Value = 3 Then
        CrucibleSetup = "Crucible Lift"
    ElseIf Home.Cells(2, 20).Value = 4 Then
        CrucibleSetup = "Other"
    End If
    MLowerSupportPlateOut = Home.Cells(10, 4).Value
    MLowerSupportPlateIn = Home.Cells(13, 4).Value
    MHeatPackTop = Home.Cells(18, 4).Value
    MHeatPackCenter12 = Home.Cells(21, 4).Value
    MHeatPackCenter3 = Home.Cells(22, 4).Value
    MHeatPackCenter6 = Home.Cells(23, 4).Value
    MHeatPackCenter9 = Home.Cells(24, 4).Value
    MSusceptor12 = Home.Cells(29, 4).Value
    MSusceptor3 = Home.Cells(30, 4).Value
    MSusceptor6 = Home.Cells(31, 4).Value
    MSusceptor9 = Home.Cells(32, 4).Value
    MOuterCrucible = Home.Cells(37, 4).Value
    MMiddleCrucible = Home.Cells(38, 4).Value
    MInnerCrucible = Home.Cells(39, 4).Value
    MConeBottom = Home.Cells(44, 4).Value
    MConeCenter12 = Home.Cells(47, 4).Value
    MConeCenter3 = Home.Cells(48, 4).Value
    MConeCenter6 = Home.Cells(49, 4).Value
    MConeCenter9 = Home.Cells(50, 4).Value
    MFeedTubeStand = Home.Cells(55, 4).Value
    
    'Output to Database
    Dim oDAO As DAO.DBEngine, oDB As DAO.Database, oRS As DAO.Recordset
    Set oDAO = New DAO.DBEngine
    Set oDB = oDAO.OpenDatabase(DBPath)
    Set oRS = oDB.OpenRecordset("Stack Heights")
    
    oRS.AddNew
    oRS.Fields("Grower") = Grower
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("Run") = Run Else oRS.Fields("Run") = Null
    oRS.Fields("Timestamp") = Timestamp
    oRS.Fields("Initials") = Initials
    oRS.Fields("AssemblyNum") = Assembly
    oRS.Fields("TurnType") = TurnType
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("CrucibleSetup") = CrucibleSetup Else oRS.Fields("CrucibleSetup") = Null
    If Home.Cells(1, 20).Value = 1 Then oRS.Fields("MLowerSupportPlateOut") = MLowerSupportPlateOut Else oRS.Fields("MLowerSupportPlateOut") = Null
    If Home.Cells(1, 20).Value = 1 Then oRS.Fields("MLowerSupportPlateIn") = MLowerSupportPlateIn Else oRS.Fields("MLowerSupportPlateIn") = Null
    oRS.Fields("MHeatPackTop") = MHeatPackTop
    oRS.Fields("MHeatPackCenter12") = MHeatPackCenter12
    oRS.Fields("MHeatPackCenter3") = MHeatPackCenter3
    oRS.Fields("MHeatPackCenter6") = MHeatPackCenter6
    oRS.Fields("MHeatPackCenter9") = MHeatPackCenter9
    oRS.Fields("MSusceptor12") = MSusceptor12
    oRS.Fields("MSusceptor3") = MSusceptor3
    oRS.Fields("MSusceptor6") = MSusceptor6
    oRS.Fields("MSusceptor9") = MSusceptor9
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MOuterCrucible") = MOuterCrucible Else oRS.Fields("MOuterCrucible") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MMiddleCrucible") = MMiddleCrucible Else oRS.Fields("MMiddleCrucible") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MInnerCrucible") = MInnerCrucible Else oRS.Fields("MInnerCrucible") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MConeBottom") = MConeBottom Else oRS.Fields("MConeBottom") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MConeCenter12") = MConeCenter12 Else oRS.Fields("MConeCenter12") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MConeCenter3") = MConeCenter3 Else oRS.Fields("MConeCenter3") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MConeCenter6") = MConeCenter6 Else oRS.Fields("MConeCenter6") = Null
    If Home.Cells(1, 20).Value = 2 Then oRS.Fields("MConeCenter9") = MConeCenter9 Else oRS.Fields("MConeCenter9") = Null
    If Home.Cells(5, 2).Value = "80-00890 (Prius)" And Home.Cells(1, 20).Value = 2 Then oRS.Fields("MFeedTubeStand") = MFeedTubeStand Else oRS.Fields("MFeedTubeStand") = Null
    
    oRS.Update
    
    'Replaced Parts Loop
    Set oRS = oDB.OpenRecordset("Replaced Parts")
    
    r = 3
    Do Until IsEmpty(Home.Cells(r, 12))
        If Home.Cells(r, 12).Value Then
            Drawing = Home.Cells(r, 9).Value
            Description = Home.Cells(r, 10).Value
            QtyReplaced = Home.Cells(r, 13).Value
            Comment = Home.Cells(r, 14).Value
            
            oRS.AddNew
            oRS.Fields("Grower") = Grower
            oRS.Fields("Run") = Run
            oRS.Fields("TimeStamp") = Timestamp
            oRS.Fields("DrawingNum") = Drawing
            oRS.Fields("Description") = Description
            oRS.Fields("QtyReplaced") = QtyReplaced
            oRS.Fields("Comment") = Comment
            
            oRS.Update
        End If
    
        r = r + 1
    Loop
    
    oDB.Close
    
    'clear form
    With Home
        .Cells(1, 2).ClearContents
        .Cells(2, 2).ClearContents
        .Cells(4, 2).ClearContents
        .Cells(5, 2).ClearContents
        .Cells(10, 4).ClearContents
        .Cells(13, 4).ClearContents
        .Cells(18, 4).ClearContents
        .Cells(21, 4).ClearContents
        .Cells(22, 4).ClearContents
        .Cells(23, 4).ClearContents
        .Cells(24, 4).ClearContents
        .Cells(29, 4).ClearContents
        .Cells(30, 4).ClearContents
        .Cells(31, 4).ClearContents
        .Cells(32, 4).ClearContents
        .Cells(37, 4).ClearContents
        .Cells(38, 4).ClearContents
        .Cells(39, 4).ClearContents
        .Cells(44, 4).ClearContents
        .Cells(47, 4).ClearContents
        .Cells(48, 4).ClearContents
        .Cells(49, 4).ClearContents
        .Cells(50, 4).ClearContents
        .Cells(55, 4).ClearContents
        .Cells(1, 20).ClearContents
        .Cells(2, 20).ClearContents
    End With
    
    r = 3
    Do Until IsEmpty(Home.Cells(r, 12))
        With Home
            .Cells(r, 12).Value = False
            .Cells(r, 13).ClearContents
            .Cells(r, 14).ClearContents
        End With
        r = r + 1
    Loop

    MsgBox ("Stack recorded successfully")

End Sub

 

[Joe4]

I cannot say that I am familiar with the methodology that you are using to transfer the data to Access. I was wondering about your variable declarations, but see that they appear to be in order.
Quite frankly, I think Access forms are WAY easier than Excel forms, as you can make them bound to your Access table. So there is no need to write VBA code to write the data to the table, it happens automatically.

I am sorry, but I don't really have much else to offer you on this one.