User Form Data Transfer Taking Several Minutes To Update Vs Seconds

PPriest · May 19, 2020

All,

I am having trouble with taking information from a user form and populating that information into a database. Looking for as much feedback as I can get to speed up this process to several minutes 5+ - 10+ minutes depending on the day down to seconds if possible. The bottleneck, from watching the code run, seems to be the individual data transfers from the user form textboxes to the database.

Here is my code:

VBA Code:

Private Sub SubmitButton_Click()
    Dim AllReq, AllAct As String
   
     ' This just gives me the row number in the database in which to record the info from the user form
    If ThisWorkbook.Sheets("Production Numbers").Range("AT14").Value <> "" Then
        rowNum = ThisWorkbook.Sheets("Production Numbers").Range("AT14").Value
    Else: rowNum = ThisWorkbook.Sheets("Production Numbers").Range("AT16").Value
    End If
    
     ' Verifies that all required fields are filled in before allowing the code to run
    If Daily_Production_Results.RR390Act.Value = "" And Daily_Production_Results.SP390Act.Value = "" And Daily_Production_Results.RCAct.Value = "" And _
        Daily_Production_Results.SCAct.Value = "" And Daily_Production_Results.FCAct.Value = "" And Daily_Production_Results.PEAct.Value = "" And _
        Daily_Production_Results.WaveAct.Value = "" And Daily_Production_Results.WPAct.Value = "" And Daily_Production_Results.RCServiceAct.Value = "" And _
        Daily_Production_Results.RCRemanAct.Value = "" And Daily_Production_Results.SCServiceAct.Value = "" And Daily_Production_Results.RCReworkAct.Value = "" And _
        Daily_Production_Results.SCReworkAct.Value = "" Then
        MsgBox "Please enter data before attempting to submit.", vbCritical, "Data Required!"
        Exit Sub
        End If
   
     ' Fills in empty spaces if no data was entered on certain fields
    If Daily_Production_Results.RR390Act.Value = "" Then
        Daily_Production_Results.RR390Act.Value = 0
        End If
    If Daily_Production_Results.RR400Act.Value = "" Then
        Daily_Production_Results.RR400Act.Value = 0
        End If
    If Daily_Production_Results.SP390Act.Value = "" Then
        Daily_Production_Results.SP390Act.Value = 0
        End If
    If Daily_Production_Results.SP400Act.Value = "" Then
        Daily_Production_Results.SP400Act.Value = 0
        End If
    If Daily_Production_Results.RCAct.Value = "" Then
        Daily_Production_Results.RCAct.Value = 0
        End If
    If Daily_Production_Results.SCAct.Value = "" Then
        Daily_Production_Results.SCAct.Value = 0
        End If
    If Daily_Production_Results.RCSCSubAct.Value = "" Then
        Daily_Production_Results.RCSCSubAct.Value = 0
        End If
    If Daily_Production_Results.FCAct.Value = "" Then
        Daily_Production_Results.FCAct.Value = 0
        End If
    If Daily_Production_Results.PEAct.Value = "" Then
        Daily_Production_Results.PEAct.Value = 0
        End If
    If Daily_Production_Results.WaveAct.Value = "" Then
        Daily_Production_Results.WaveAct.Value = 0
        End If
    If Daily_Production_Results.WPAct.Value = "" Then
        Daily_Production_Results.WPAct.Value = 0
        End If
    If Daily_Production_Results.RCServiceAct.Value = "" Then
        Daily_Production_Results.RCServiceAct.Value = 0
        End If
    If Daily_Production_Results.RCRemanAct.Value = "" Then
        Daily_Production_Results.RCRemanAct.Value = 0
        End If
    If Daily_Production_Results.SCServiceAct.Value = "" Then
        Daily_Production_Results.SCServiceAct.Value = 0
        End If
    If Daily_Production_Results.RCReworkAct.Value = "" Then
        Daily_Production_Results.RCReworkAct.Value = 0
        End If
    If Daily_Production_Results.SCReworkAct.Value = "" Then
        Daily_Production_Results.SCReworkAct.Value = 0
        End If
   
     ' used to do some calculations of totals for all fields entered
    rrTReq = Daily_Production_Results.RR390Tar.Caption
    spTReq = Daily_Production_Results.SP390Tar.Caption
    rcTReq = Daily_Production_Results.RCTar.Caption
    scTReq = Daily_Production_Results.SCTar.Caption
    fcTReq = Daily_Production_Results.FCTar.Caption
    peTReq = Daily_Production_Results.PETar.Caption
    waveTReq = Daily_Production_Results.WaveTar.Caption
    wpTReq = Daily_Production_Results.WPTar.Caption
    rrTAct = Daily_Production_Results.RR390Act.Value
    spTAct = Daily_Production_Results.SP390Act.Value
    rcTAct = Daily_Production_Results.RCAct.Value
    scTAct = Daily_Production_Results.SCAct.Value
    fcTAct = Daily_Production_Results.FCAct.Value
    peTAct = Daily_Production_Results.PEAct.Value
    waveTAct = Daily_Production_Results.WaveAct.Value
    wpTAct = Daily_Production_Results.WPAct.Value
    rcservTAct = Daily_Production_Results.RCServiceAct.Value
    rcremanTAct = Daily_Production_Results.RCRemanAct.Value
    scservTAct = Daily_Production_Results.SCServiceAct.Value
   
    AllReqO = CInt(rrTReq) + CInt(spTReq) + CInt(rcTReq) + CInt(scTReq) + CInt(fcTReq) + CInt(peTReq) + CInt(waveTReq) + CInt(wpTReq) + CInt(rcservTAct) + CInt(rcremanTAct) + CInt(scservTAct)
    AllActO = CInt(rrTAct) + CInt(spTAct) + CInt(rcTAct) + CInt(scTAct) + CInt(fcTAct) + CInt(peTAct) + CInt(waveTAct) + CInt(wpTAct) + CInt(rcservTAct) + CInt(rcremanTAct) + CInt(scservTAct)
    ' trying to convert totals into decimal places
    AllReq = Format(AllReqO, "##,##0.00")
    AllAct = Format(AllActO, "##,##0.00")
   
     ' Begin transferring data to database on another workbook
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Unprotect "passcode"
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("A" & rowNum).Value = Daily_Production_Results.selDate.Caption
    If selShift = 0.1 Then
        Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("B" & rowNum).Value = 3
    ElseIf selShift = 0.2 Then
        Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("B" & rowNum).Value = 1
    ElseIf selShift = 0.3 Then
        Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("B" & rowNum).Value = 2
    ElseIf selShift = 0.4 Then
        Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("B" & rowNum).Value = "Sat"
    ElseIf selShift = 0.5 Then
        Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("B" & rowNum).Value = "Sun"
    End If
    Workbooks("GEMBA BOARD DAILY PRODUCTION SHEET.xlsm").Worksheets("Production Targets").Range("C1").Value = Daily_Production_Results.dateShiftCombo.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("C" & rowNum).Value = Daily_Production_Results.dateShiftCombo.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("D" & rowNum).Value = Daily_Production_Results.RR390Tar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("E" & rowNum).Value = Daily_Production_Results.RR390Act.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AJ" & rowNum).Value = Daily_Production_Results.RR400Tar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AK" & rowNum).Value = Daily_Production_Results.RR400Act.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("F" & rowNum).Value = Daily_Production_Results.SP390Tar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("G" & rowNum).Value = Daily_Production_Results.SP390Act.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AL" & rowNum).Value = Daily_Production_Results.SP400Tar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AM" & rowNum).Value = Daily_Production_Results.SP400Act.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AN" & rowNum).Value = Daily_Production_Results.RCSCSubTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AO" & rowNum).Value = Daily_Production_Results.RCSCSubAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("H" & rowNum).Value = Daily_Production_Results.RCTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("I" & rowNum).Value = Daily_Production_Results.RCAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("J" & rowNum).Value = Daily_Production_Results.SCTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("K" & rowNum).Value = Daily_Production_Results.SCAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("L" & rowNum).Value = Daily_Production_Results.FCTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("M" & rowNum).Value = Daily_Production_Results.FCAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("N" & rowNum).Value = Daily_Production_Results.PETar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("O" & rowNum).Value = Daily_Production_Results.PEAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("P" & rowNum).Value = Daily_Production_Results.WaveTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("Q" & rowNum).Value = Daily_Production_Results.WaveAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("R" & rowNum).Value = Daily_Production_Results.WPTar.Caption
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("S" & rowNum).Value = Daily_Production_Results.WPAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("T" & rowNum).Value = AllReq
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("U" & rowNum).Value = AllAct
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("V" & rowNum).Value = Daily_Production_Results.RCRemanAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("W" & rowNum).Value = Daily_Production_Results.RCRemanAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("X" & rowNum).Value = Daily_Production_Results.RCServiceAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("Y" & rowNum).Value = Daily_Production_Results.RCServiceAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("Z" & rowNum).Value = Daily_Production_Results.SCServiceAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AA" & rowNum).Value = Daily_Production_Results.SCServiceAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AB" & rowNum).Value = Daily_Production_Results.RCReworkAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AC" & rowNum).Value = Daily_Production_Results.RCReworkAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AD" & rowNum).Value = Daily_Production_Results.SCReworkAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AE" & rowNum).Value = Daily_Production_Results.SCReworkAct.Value
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AF" & rowNum).Value = CInt(rcTReq) + CInt(rcservTAct) + CInt(rcremanTAct)
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AG" & rowNum).Value = CInt(rcTAct) + rcservTAct + rcremanTAct
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AH" & rowNum).Value = CInt(scTReq) + scservTAct
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AI" & rowNum).Value = CInt(scTAct) + scservTAct
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Range("AS" & rowNum).Value = "=row()"
   
    Workbooks("Production Interruption Report.xlsm").Sheets("Daily Production").Protect "passcode", True, True
   
    Workbooks("Production Interruption Report.xlsm").Save
   
     ' Copies over data for use in calculations - this is not what slows down the data transfer
    'The following updates the production numbers
    Workbooks("GEMBA BOARD DAILY PRODUCTION SHEET.xlsm").Worksheets("Production Numbers").Range("B1") = Format(Now(), "mm/dd/yyyy")
    With ThisWorkbook.Worksheets("Production Numbers")
        Workbooks(.Range("B11").Value).Worksheets(.Range("B12").Value).Range(.Range("B7").Value & ":" & .Range("B8").Value).Copy
        Workbooks("GEMBA BOARD DAILY PRODUCTION SHEET.xlsm").Worksheets("Production Numbers").Range("A15").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
           
    Unload Me
    Application.ScreenUpdating = False
   
    Application.ScreenUpdating = True
    'Application.DisplayAlerts = False
    'Workbooks("Production Interruption Report.xlsm").Close
    'Application.DisplayAlerts = True
    Workbooks("GEMBA BOARD DAILY PRODUCTION SHEET.xlsm").Save
           
End Sub

dmt32 · May 19, 2020

Looks like far too many lines of code to do what you want - maybe better to read all in to an array & then output this to your range?

Helpful if you could place copy of your workbook in a dropbox & provide link to it here.

Dave

PPriest · May 19, 2020

dmt32 said:
Looks like far too many lines of code to do what you want - maybe better to read all in to an array & then output this to your range?

Helpful if you could place copy of your workbook in a dropbox & provide link to it here.

Dave

It's a rather large workbook with proprietary information I'm afraid. Can you give me a sample on what you mean? Not sure what the syntax would look like.

dmt32 · May 19, 2020

PPriest said:
It's a rather large workbook with proprietary information I'm afraid. Can you give me a sample on what you mean? Not sure what the syntax would look like.

Just make a stripped down version with userform & database removing any sensitive information.

Sample idea would be say you have ten textboxes with their default names - you can loop through them to populate an array & then pass this to your range. This way, you only write once to the range.

example code

VBA Code:

Private Sub CommandButton1_Click()
Dim arr(1 To 10) As Variant
Dim ws As Worksheet
Dim i As Integer
Dim lastrow As Long

'set object variable to database
Set ws = ThisWorkbook.Worksheets("Daily Production")
'get last row
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

'populate array with textbox values
For i = 1 To 10
    With Me.Controls("TextBox" & i)
'corece text values to required data type
        If IsDate(.Value) Then
            arr(i) = DateValue(.Value)
        ElseIf IsNumeric(.Value) Then
            arr(i) = Val(.Value)
        Else
            arr(i) = .Value
        End If
       End With
Next i

'output array to database
ws.Cells(lastrow, 1).Resize(, UBound(arr)).Value = arr
End Sub

You have given your controls different names which creates bit more work but same approach can still be taken.

Hope helpful

Dave

PPriest · May 19, 2020

dmt32 said:
Just make a stripped down version with userform & database removing any sensitive information.

Sample idea would be say you have ten textboxes with their default names - you can loop through them to populate an array & then pass this to your range. This way, you only write once to the range.

example code

VBA Code:

Private Sub CommandButton1_Click() Dim arr(1 To 10) As Variant Dim ws As Worksheet Dim i As Integer Dim lastrow As Long 'set object variable to database Set ws = ThisWorkbook.Worksheets("Daily Production") 'get last row lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1 'populate array with textbox values For i = 1 To 10 With Me.Controls("TextBox" & i) 'corece text values to required data type If IsDate(.Value) Then arr(i) = DateValue(.Value) ElseIf IsNumeric(.Value) Then arr(i) = Val(.Value) Else arr(i) = .Value End If End With Next i 'output array to database ws.Cells(lastrow, 1).Resize(, UBound(arr)).Value = arr End Sub

You have given your controls different names which creates bit more work but same approach can still be taken.

Hope helpful

Dave

Production Interruption Report.xlsm
GEMBA BOARD DAILY PRODUCTION SHEET.xlsm

dmt32 · May 19, 2020

You Form errors with missing object when one of the day optionbuttons selected

VBA Code:

Daily_Production_Results.RR390Act

Can you resolve the error(s) & when form working, re-post

Dave

dmt32 · May 23, 2020

I found other controls listed in your codes ( see below) that do not exist on your userform - without a complete userform, it will be difficult to assist further.
I note you have taken the links down so conclude that you may have resolved your issue?

RR390Act	missing
RR400Act	missing
SP390Act	missing
SP400Act	missing
RCSCSubAct	missing
RCAct	missing
SCAct	missing
FCAct	missing
PEAct	missing
WaveAct	missing
WPAct	missing
RCServiceAct	missing
RCRemanAct	missing
RCReworkAct	missing
SCServiceAct	missing
SCReworkAct	missing

PPriest · May 27, 2020

dmt32 said:
I found other controls listed in your codes ( see below) that do not exist on your userform - without a complete userform, it will be difficult to assist further.
I note you have taken the links down so conclude that you may have resolved your issue?

RR390Act missing
RR400Act missing
SP390Act missing
SP400Act missing
RCSCSubAct missing
RCAct missing
SCAct missing
FCAct missing
PEAct missing
WaveAct missing
WPAct missing
RCServiceAct missing
RCRemanAct missing
RCReworkAct missing
SCServiceAct missing
SCReworkAct missing

No - the issue is not resolved. I was pulled into a few other issues and have not been able to get back to this yet. I will try and strip down my main file again and repost.

User Form Data Transfer Taking Several Minutes To Update Vs Seconds

PPriest

New Member

Excel Facts

dmt32

Well-known Member

PPriest

New Member

dmt32

Well-known Member

PPriest

New Member

dmt32

Well-known Member

dmt32

Well-known Member

PPriest

New Member

Similar threads

Forum statistics

Share this page

User Form Data Transfer Taking Several Minutes To Update Vs Seconds

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock