code is langzaam

[mnemonic]

Hallo, Ik heb een user formulier gemaakt met 73 textboxen.
Daar worden gegevens ingevuld.
Als we op opslaan drukken worden de gegevens van die textboxen op een regel geplaatst in een tabel op een sheet.
Dit neemt meer dan een minuut in beslag.
Nu is mijn vraag: Kan de onderstaande code ook aangepast worden zodat deze sneller werkt?

Private Sub CommandButton4_Click()
Sheets("1430").Unprotect Password:="WW"
    Application.ScreenUpdating = False
If TextBox223 = Empty Then
    MsgBox "Datum invoeren A.u.b."
    Exit Sub
End If

If TextBox224 = Empty Then
    MsgBox "Aantal ritten invoeren A.u.b."
    Exit Sub
End If

With Sheets("1430")
        lRow = .Range("A10000").End(xlUp).Offset(1).Row
        .Cells(lRow, 1) = TextBox223.Value
        For i = 223 To 296
             .Cells(lRow, i - 222) = Me("TextBox" & i).Value
        Next
    End With
        MsgBox "Waarden zijn opgeslagen in de database!", vbOKOnly
        For i = 223 To 296
        Controls("TextBox" & i).Value = ""

        Next
    Application.ScreenUpdating = True
Sheets("1430").Protect Password:="WW"
End Sub

Alvast bedankt voor het mee denken.

 

[HSV]

Zet ze in een array en schrijf ze dan pas weg ipv een voor een.

dim arr(73), i as long
for i = 1 To 74
arr(i - 1) = me("textbox" & i)
next i
cells(rows.count,1).end(xlup).offset(1).resize(,74) =arr

 

[mnemonic]

Harry bedankt voor het mee denken.
Kun je mij een beetje op weg helpen?

Private Sub CommandButton4_Click()
Dim arr(74), i As Long
Sheets("1430").Unprotect Password:="ww"
    Application.ScreenUpdating = False
If TextBox223 = Empty Then
    MsgBox "Datum invoeren A.u.b."
    Exit Sub
End If

If TextBox224 = Empty Then
    MsgBox "Aantal ritten invoeren A.u.b."
    Exit Sub
End If

With Sheets("1430")
        'lRow = .Range("A10000").End(xlUp).Offset(1).Row
        '.Cells(lRow, 1) = TextBox223.Value
        'For i = 223 To 296
         '    .Cells(lRow, i - 222) = Me("TextBox" & i).Value
         '
        
        For i = 223 To 296
        arr(i - 1) = Me("textbox" & i)
        Next i
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr
      
    End With
        MsgBox "Waarden zijn opgeslagen in de database!", vbOKOnly
        For i = 223 To 296
        Controls("TextBox" & i).Value = ""

        Next
    Application.ScreenUpdating = True
Sheets("1430").Protect Password:="ww"
End Sub

Ik krijg bij "arr(i - 1) = Me("textbox" & i)" de melding dat dit buiten het bereik ligt?
Gr. Jan

 

[HSV]

test het zo maar eens

Dim arr(73)

en..

arr(i - 223)

 

[mnemonic]

Nu loopt hij een regel verder vast.

Private Sub CommandButton4_Click()

Sheets("1430").Unprotect Password:="ww"
Dim arr(73), i As Long

    Application.ScreenUpdating = False
If TextBox223 = Empty Then
    MsgBox "Datum invoeren A.u.b."
    Exit Sub
End If

If TextBox224 = Empty Then
    MsgBox "Aantal ritten invoeren A.u.b."
    Exit Sub
End If

With Sheets("1430")

        
        For i = 223 To 296
        arr(i - 223) = Me("textbox" & i)
        Next i
    [COLOR="#FF0000"]    Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr[/COLOR]
      
    End With
        MsgBox "Waarden zijn opgeslagen in de database!", vbOKOnly
        For i = 223 To 296
        Controls("TextBox" & i).Value = ""

        Next
    Application.ScreenUpdating = True
Sheets("1430").Protect Password:="ww"
End Sub

Nu krijg ik bij, Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr de melding dat hij dit niet kan uitvoeren op een beveiligd blad?
Maar die schakel ik in het begin toch uit met, Sheets("1430").Unprotect Password:="ww"?

 

[HSV]

Zo verwijst de code naar het actieve blad.

Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr

En zo naar blad "1430"

[SIZE=6][COLOR=#ff0000].[/COLOR][/SIZE]Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr

Beter uitgeschreven:

Private Sub CommandButton4_Click()
Dim arr(73), i As Long
Application.ScreenUpdating = False
with Sheets("1430")
   .Unprotect Password:="ww"

If TextBox223 = Empty Then
    MsgBox "Datum invoeren A.u.b."
    Exit Sub
End If

If TextBox224 = Empty Then
    MsgBox "Aantal ritten invoeren A.u.b."
    Exit Sub
End If
        For i = 223 To 296
          arr(i - 223) = Me("textbox" & i)
        Next i
           .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr
            MsgBox "Waarden zijn opgeslagen in de database!", vbOKOnly
        For i = 223 To 296
            Controls("TextBox" & i).Value = ""
        Next i
   .Protect Password:="ww"
 end with
End Sub

 

[VenA]

Dat idee had ik ook.:d

Zet de code in een logische volgorde dan vallen zulke probleempjes sneller op.

Private Sub CommandButton4_Click()
Dim arr(73), i As Long
  Application.ScreenUpdating = False
  If TextBox223 = Empty Then
    MsgBox "Datum invoeren A.u.b."
    Exit Sub
  End If
  If TextBox224 = Empty Then
    MsgBox "Aantal ritten invoeren A.u.b."
    Exit Sub
  End If
  
  With Sheets("1430")
    .Unprotect "ww"
    For i = 223 To 296
      arr(i - 223) = Me("textbox" & i)
      Next i
      [COLOR=#ff0000].[/COLOR]Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 74) = arr
      .Protect "ww"
  End With
  
  MsgBox "Waarden zijn opgeslagen in de database!", vbOKOnly
    For i = 223 To 296
      Controls("TextBox" & i).Value = ""
    Next i
End Sub

 

[mnemonic]

Vena bedankt voor de tip en Harry bedankt voor de oplossing.
Alles werkt nu super.
Nogmaals bedankt.:thumb: