Ik heb met VBA een klein probleempje. Ik heb namelijk een procedure geschreven in vba, maar deze is te groot. Ik zal hieronder een klein stukje plakken.
Deze code gaat tot checkbox 20 door. Dit wordt niet door vba geaccepteerd. Heeft iemand een idee om deze code in te korten? Op dit moment wordt er per checkbox gekeken welk product het is. Hier valt een hoop op te schrappen, maar ik zou niet weten hoe
Ik hoop dat jullie mij kunnen helpen :thumb:
Code:
Private Sub CommandButtonVerwerkDistributie_Click()
If CheckBox1.Value = True Then
If Worksheets("Distributiescherm").Range("A4") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A4:E4")) < 5 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
LR = Worksheets("Distributie historie").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets("Distributie historie")
.Cells(LR, 1) = Sheets("Distributiescherm").Cells(4, 1)
.Cells(LR, 2) = Sheets("Distributiescherm").Cells(4, 2)
.Cells(LR, 3) = Sheets("Distributiescherm").Cells(4, 3)
.Cells(LR, 4) = Sheets("Distributiescherm").Cells(4, 4)
.Cells(LR, 5) = Sheets("Distributiescherm").Cells(4, 5)
.Cells(LR, 6) = Sheets("Distributiescherm").Cells(4, 6)
.Cells(LR, 7) = Sheets("Distributiescherm").Cells(4, 7)
.Cells(LR, 8) = Sheets("Distributiescherm").Cells(4, 8)
End With
Select Case Range("A4").Value
Case "sk335126"
If Worksheets("Voorraadverloop").Range("A6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("A5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 1) = Sheets("Voorraadscherm").Cells(4, 1)
.Cells(LR, 3) = Sheets("Voorraadscherm").Cells(4, 3)
.Cells(LR, 4) = Sheets("Voorraadscherm").Cells(4, 4)
.Cells(LR, 5) = Sheets("Voorraadscherm").Cells(4, 5)
End With
Case "rt3623223"
If Worksheets("Voorraadverloop").Range("I6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("I5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 9) = Sheets("Voorraadscherm").Cells(4, 1)
.Cells(LR, 11) = Sheets("Voorraadscherm").Cells(4, 3)
.Cells(LR, 12) = Sheets("Voorraadscherm").Cells(4, 4)
.Cells(LR, 13) = Sheets("Voorraadscherm").Cells(4, 5)
End With
Case "123"
If Worksheets("Voorraadverloop").Range("Q6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("Q5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 17) = Sheets("Voorraadscherm").Cells(4, 1)
.Cells(LR, 19) = Sheets("Voorraadscherm").Cells(4, 3)
.Cells(LR, 20) = Sheets("Voorraadscherm").Cells(4, 4)
.Cells(LR, 21) = Sheets("Voorraadscherm").Cells(4, 5)
End With
Case "456"
If Worksheets("Voorraadverloop").Range("Y6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("Y5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 25) = Sheets("Voorraadscherm").Cells(4, 1)
.Cells(LR, 27) = Sheets("Voorraadscherm").Cells(4, 3)
.Cells(LR, 28) = Sheets("Voorraadscherm").Cells(4, 4)
.Cells(LR, 29) = Sheets("Voorraadscherm").Cells(4, 5)
End With
End Select
CheckBox1.Value = False
Sheets("Distributiescherm").Range("A4:E4").ClearContents
End If
End If
If CheckBox2.Value = True Then
If Worksheets("Distributiescherm").Range("A5") = "" Then
CheckBox2.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A5:E5")) < 5 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
LR = Worksheets("Distributie historie").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Sheets("Distributie historie")
.Cells(LR, 1) = Sheets("Distributiescherm").Cells(5, 1)
.Cells(LR, 2) = Sheets("Distributiescherm").Cells(5, 2)
.Cells(LR, 3) = Sheets("Distributiescherm").Cells(5, 3)
.Cells(LR, 4) = Sheets("Distributiescherm").Cells(5, 4)
.Cells(LR, 5) = Sheets("Distributiescherm").Cells(5, 5)
.Cells(LR, 6) = Sheets("Distributiescherm").Cells(5, 6)
.Cells(LR, 7) = Sheets("Distributiescherm").Cells(5, 7)
.Cells(LR, 8) = Sheets("Distributiescherm").Cells(5, 8)
End With
Select Case Range("A5").Value
Case "sk335126"
If Worksheets("Voorraadverloop").Range("A6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("A5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 1) = Sheets("Voorraadscherm").Cells(5, 1)
.Cells(LR, 3) = Sheets("Voorraadscherm").Cells(5, 3)
.Cells(LR, 4) = Sheets("Voorraadscherm").Cells(5, 4)
.Cells(LR, 5) = Sheets("Voorraadscherm").Cells(5, 5)
End With
Case "rt3623223"
If Worksheets("Voorraadverloop").Range("I6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("I5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 9) = Sheets("Voorraadscherm").Cells(5, 1)
.Cells(LR, 11) = Sheets("Voorraadscherm").Cells(5, 3)
.Cells(LR, 12) = Sheets("Voorraadscherm").Cells(5, 4)
.Cells(LR, 13) = Sheets("Voorraadscherm").Cells(5, 5)
End With
Case "123"
If Worksheets("Voorraadverloop").Range("Q6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("Q5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 17) = Sheets("Voorraadscherm").Cells(5, 1)
.Cells(LR, 19) = Sheets("Voorraadscherm").Cells(5, 3)
.Cells(LR, 20) = Sheets("Voorraadscherm").Cells(5, 4)
.Cells(LR, 21) = Sheets("Voorraadscherm").Cells(5, 5)
End With
Case "456"
If Worksheets("Voorraadverloop").Range("Y6") = "" Then
LR = 6
Else
LR = Worksheets("Voorraadverloop").Range("Y5").End(xlDown).Row + 1
End If
With Sheets("Voorraadverloop")
.Cells(LR, 25) = Sheets("Voorraadscherm").Cells(5, 1)
.Cells(LR, 27) = Sheets("Voorraadscherm").Cells(5, 3)
.Cells(LR, 28) = Sheets("Voorraadscherm").Cells(5, 4)
.Cells(LR, 29) = Sheets("Voorraadscherm").Cells(5, 5)
End With
End Select
CheckBox2.Value = False
Sheets("Distributiescherm").Range("A5:E5").ClearContents
End If
End If
Deze code gaat tot checkbox 20 door. Dit wordt niet door vba geaccepteerd. Heeft iemand een idee om deze code in te korten? Op dit moment wordt er per checkbox gekeken welk product het is. Hier valt een hoop op te schrappen, maar ik zou niet weten hoe
Ik hoop dat jullie mij kunnen helpen :thumb: