Optimizing Data Entry - Help!

[kimbellcf]

The following code works. The data is entered via a user form and when the user clicks 'enter' the sub below is activated. It does however take about 10 sec for the data to be entered on spreadsheet. Is there any way to make the sub run faster? Many thanks in advance.

Private Sub CommandButton5_Click()

Application.ScreenUpdating = False


Range("A7").Select
Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

ActiveCell.Value = txtDateofFlight.Value
ActiveCell.Offset(0, 1) = cbbtypeofac.Value
ActiveCell.Offset(0, 2) = cbbFARpart.Value
ActiveCell.Offset(0, 3) = cbbRegistration.Value
ActiveCell.Offset(0, 4) = txtNameCFIstuCapt.Value
ActiveCell.Offset(0, 5) = txtRouteofFlight.Value
ActiveCell.Offset(0, 6) = txtSELPistonPIC.Value
ActiveCell.Offset(0, 7) = txtSELPistonDUAL.Value
ActiveCell.Offset(0, 8) = txtSELTurbopropPIC.Value
ActiveCell.Offset(0, 9) = txtSELTurbopropSIC.Value
ActiveCell.Offset(0, 10) = txtSELTurbopropDual.Value
ActiveCell.Offset(0, 11) = txtMELPistonPIC.Value
ActiveCell.Offset(0, 12) = txtMELPistonSIC.Value
ActiveCell.Offset(0, 13) = txtMELPistonDual.Value
ActiveCell.Offset(0, 14) = txtMELTurbopropPIC.Value
ActiveCell.Offset(0, 15) = txtMELTurbopropSIC.Value
ActiveCell.Offset(0, 16) = txtMELTurbojetPIC.Value
ActiveCell.Offset(0, 17) = txtMELTurbojetSIC.Value
ActiveCell.Offset(0, 18) = txtHelicopterCLASS.Value
ActiveCell.Offset(0, 19) = txtGliderCLASS.Value
ActiveCell.Offset(0, 20) = txtSeaplaneCLASS.Value
ActiveCell.Offset(0, 21) = txtLighterthanAirCLASS.Value
ActiveCell.Offset(0, 22) = txtLndDAY.Value
ActiveCell.Offset(0, 23) = txtlndNIGHT.Value
ActiveCell.Offset(0, 24) = txtCondofFltNIGHT.Value
ActiveCell.Offset(0, 25) = txtCondofFltSimulatedInst.Value
ActiveCell.Offset(0, 26) = txtCondofFltSimulatorCD.Value
ActiveCell.Offset(0, 27) = txtCondofFltActualInst.Value
ActiveCell.Offset(0, 28) = txtCondofFltInstApp.Value
ActiveCell.Offset(0, 29) = cbbAirwayNav.Value
ActiveCell.Offset(0, 30) = cbbHold.Value
ActiveCell.Offset(0, 31) = txtTofPTCrossCountry.Value
ActiveCell.Offset(0, 32) = txtTofPTInstructorTime.Value
ActiveCell.Offset(0, 33) = txtTofPTFltEngineer.Value
ActiveCell.Offset(0, 34) = txtTofPTFltNavigator.Value
ActiveCell.Offset(0, 35) = txtREMARKS.Value

Unload Me

Application.ScreenUpdating = True

Range("a10051").End(xlUp).Offset(1, 0).Select

End Sub

[arthurbr]

Hi and welcome to the board

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here