• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

procedure te groot

Status
Niet open voor verdere reacties.
Nou hij werkt helemaal geweldig! :thumb:

Het enige wat anders moest is dat iBR 21 moest zijn, maar dat is een onbenullig detail ;)

Mocht ik nog probleempjes ondervinden, laat ik het wel weten, maar hier kan ik een heel eind mee komen. Echt super bedankt!!! :thumb:
 
Nog 1 vraagje:

Ik wil deze code ook toepassen op het verwerken van binnengekomen orders. Nu is het zo dat als de bovenste order die binnengekomen is, er voor zorgt dat alle andere orders ook in de zelfde tabel in het voorraadverloop worden geplakt.

Na het doorlopen van de code kwam ik er achter dat het onderdeel "when" hier mede schuldig aan is, maar ik heb geen idee hoe ik dit kan tackelen. Kan je me daar nog mee helpen? :eek:

Afbeelding ter ondersteuning:

2mx4tj8.jpg


huidige code:

Code: 
Private Sub CommandButtonBinnen1_Click()
Dim iRij, iBR As Integer
If CheckBox1.Value = True Then
    iBR = 4
If Worksheets("Voorraadscherm").Range("A4") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A4:H4")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(4, iKol)
Next
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Range("A4").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
            While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
                iBR = iBR + 1
                iRij = iRij + 1
            Wend
        End If
    End With
CheckBox1.Value = False
    Sheets("Voorraadscherm").Range("A4:H4").ClearContents
End If
End If
If CheckBox2.Value = True Then
    iBR = 5
If Worksheets("Voorraadscherm").Range("A5") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A5:H5")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(5, iKol)
Next
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Range("A5").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
            While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
                iBR = iBR + 1
                iRij = iRij + 1
            Wend
        End If
    End With
CheckBox2.Value = False
    Sheets("Voorraadscherm").Range("A5:H5").ClearContents
End If
End If

etc etc....
 
Laatst bewerkt:
Code: 
Private Sub CommandButtonBinnen1_Click()
Dim iRij, iBR As Integer
If CheckBox1.Value = True Then
    iBR = 4
If Worksheets("Voorraadscherm").Range("A4") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A4:H4")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(4, iKol)
Next
While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Cells(iBR,"A").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
                iBR = iBR + 1
                iRij = iRij + 1
        End If
    End With
Wend
CheckBox1.Value = False
    Sheets("Voorraadscherm").Range("A4:H4").ClearContents
End If
End If
If CheckBox2.Value = True Then
    iBR = 5
If Worksheets("Voorraadscherm").Range("A5") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A5:H5")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(5, iKol)
Next
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Range("A5").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
            While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
                iBR = iBR + 1
                iRij = iRij + 1
            Wend
        End If
    End With
CheckBox2.Value = False
    Sheets("Voorraadscherm").Range("A5:H5").ClearContents
End If
End If

etc etc....

Met vriendelijke groet,


Roncancio
 
Laatst bewerkt:
Als ik deze vervang werkt het nog steeds niet :(

Op dit moment ligt het er een beetje aan hoeveel producten er in de lijst staan. Staan er bijvoorbeeld 4 klaar, dan zal de macro het 1e product 1x aanslaan, product 2 2x, product 3 3x en product 4 4x. Heb wederom een screenshot bijgevoegd om het te verduidelijken.

Ik heb er een beetje mee lopen stoeien, maar mocht niet baten. Enig idee hoe dit aan te passen is? :confused:

2w7psug.jpg
 
Dit gaat zo niet werken.
In de code die je gestuurd hebt, werk je als volgt:

Controleer checkbox1
Als checkbox1 aangevinkt is dan ....


....
Einde


Controleer checkbox2
Als checkbox1 aangevinkt is dan ....


....
Einde
Klik om te vergroten...
De overige checkboxen staan hier niet vermeld.
Het lijkt mij het handigste om een macro te schrijven die in het werkblad het aantal checkboxen controleert.
In plaats van dat je 20* de checkbox controleert, doorloopt de macro stuk voor stuk de checkboxen en voert de handelingen uit. De hoeveelheid coderegels zal véél minder worden. Code voor 1 checkbox is dan genoeg voor alle checkboxen.

Met vriendelijke groet,


Roncancio
 
Ik heb het ietsje anders gedaan, maar op deze manier werkt het ook. Formule gaat wel traag, maar ja, ben al blij dat het eindelijk werkt na al die tijd :D

Code: 
Dim iRij, iBR As Integer
    iBR = 4
If CheckBox1.Value = False Then GoTo eind1a
If Worksheets("Voorraadscherm").Range("A4") = "" Then
CheckBox1.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A4:H4")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(4, iKol)
Next
While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Cells(iBR, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
        End If
    End With
GoTo eind1b
Wend
eind1b:
CheckBox1.Value = False
    Sheets("Voorraadscherm").Range("A4:H4").ClearContents
eind1a:
End If
    iBR = 5
If CheckBox2.Value = False Then GoTo Eind2a
If Worksheets("Voorraadscherm").Range("A5") = "" Then
CheckBox2.Value = False
Else
If Application.WorksheetFunction.CountA(Range("A5:H5")) < 8 Then
MsgBox ("Niet volledig ingevuld"): Exit Sub
End If
Lr = Worksheets("Inkoopscherm").Cells(Rows.Count, 1).End(xlUp).Row + 1
For iKol = 1 To 8
        Sheets("Inkoopscherm").Cells(Lr, iKol) = Sheets("Voorraadscherm").Cells(5, iKol)
Next
While Worksheets("Voorraadscherm").Cells(iBR, "A").Value <> ""
    With Worksheets("Voorraadverloop").Range("A1:IV10")
        Set P = .Find(Worksheets("Voorraadscherm").Cells(iBR, "A").Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not P Is Nothing Then
            iRij = Worksheets("Voorraadverloop").Cells(P.Row, P.Column).End(xlDown).Row + 1
                Worksheets("Voorraadverloop").Cells(iRij, P.Column).Value = Worksheets("Voorraadscherm").Range("A" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 2).Value = Worksheets("Voorraadscherm").Range("C" & iBR).Value
                Worksheets("Voorraadverloop").Cells(iRij, P.Column + 4).Value = Worksheets("Voorraadscherm").Range("E" & iBR).Value
        End If
    End With
GoTo Eind2b
Wend
Eind2b:
CheckBox2.Value = False
    Sheets("Voorraadscherm").Range("A5:H5").ClearContents
Eind2a:
End If

etc etc...
 
Ik heb het ietsje anders gedaan, maar op deze manier werkt het ook. Formule gaat wel traag, maar ja, ben al blij dat het eindelijk werkt na al die tijd :D
Klik om te vergroten...

Dus de vraag is hiermee opgelost ?

Met vriendelijke groet,


Roncancio
 
barbaar zei:
Jup :) Mag ik jou persoonlijk heel erg bedankt voor jouw input? Je hebt me enorm geholpen en ben er echt super blij mee.

Dus bij deze:
worshippy.gif
worshippy.gif
worshippy.gif
Klik om te vergroten...

Dank u, dank u.:eek::eek::eek::eek:
Graag gedaan.;):D

Als toegift:

Code: 
Sub ChkBox()
Dim iTel As Integer
For iTel = 1 To ActiveSheet.Shapes.Count
    If Left(ActiveSheet.Shapes(iTel).Name, 8) = "CheckBox" Then
        '[ CODE ]
    End If
Next

End Sub
Bovenstaande code controleert het aantal objecten wiens naam begint met "CheckBox".
Op de plek van de Code kan je je code zetten. Met een kleine aanpassing is de code werkzaam voor al je checkboxen. Dat scheelt enorm in coderegels.

Met vriendelijke groet,


Roncancio
 
Roncancio zei:
Dank u, dank u.:eek::eek::eek::eek:
Graag gedaan.;):D

Als toegift:

Code: 
Sub ChkBox()
Dim iTel As Integer
For iTel = 1 To ActiveSheet.Shapes.Count
    If Left(ActiveSheet.Shapes(iTel).Name, 8) = "CheckBox" Then
        '[ CODE ]
    End If
Next

End Sub
Bovenstaande code controleert het aantal objecten wiens naam begint met "CheckBox".
Op de plek van de Code kan je je code zetten. Met een kleine aanpassing is de code werkzaam voor al je checkboxen. Dat scheelt enorm in coderegels.

Met vriendelijke groet,


Roncancio
Klik om te vergroten...

Hoe is dat dan te doen in zo'n kleine code? Aangezien de iBR en het bereik per checkbox verandert. Ik ben helaas nog niet zo bekend met vba dat ik het meteen om kan zetten, werk er nu net een paar maandjes mee.

Beetje offtopic, maar hoe ben jij hier zo goed in geworden? :p
 
Code: 
Hoe is dat dan te doen in zo'n kleine code? Aangezien de iBR en het bereik per checkbox verandert. Ik ben helaas nog niet zo bekend met vba dat ik het meteen om kan zetten, werk er nu net een paar maandjes mee.
Via een zoekfunctie kan je het eea oplossen.

Code: 
Beetje offtopic, maar hoe ben jij hier zo goed in geworden? :P
Dank u. :eek:
Vooral uitproberen en zoeken naar mogelijkheden om bepaalde zaken op te lossen.
En ook nooit de illusie hebben dat je uitgeleerd bent.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan