VBA script gevraagd

[jan excel]

Hallo Experts,

Graag zou ik een VBA script willen hebben dat de voorraad checkt op bepaalde hoeveelheid.
Als bij bepaalde producten de voorraad te laag is zou ik dit via een userform in een listbox betreffende produkten willen zien.
De bijlage is een simpele voorbeeld in de praktijk is het wat complexer.
Maar als jullie in dit voorbeeld de oplossing kunnen geven denk ik dan een aanknopingspunt heb voor mijn project.

Zie bijlage dan is e.e.a. wel duidelijk.

Alvast bedankt.
Jan.

 

[masc007]

Private Sub UserForm_Initialize()
    rownr = 5
    
    Do
        Product = Trim(Sheets("Blad1").Cells(rownr, 1))
        If Product = "" Then Exit Do
        amount = Trim(Sheets("Blad1").Cells(rownr, 4))
        If amount < 3 Then
            ListBox1.AddItem Product
        End If
        rownr = rownr + 1
    Loop
End Sub

 

[VenA]

Een iets snellere variant

Private Sub UserForm_Initialize()
Dim c00 As String, j As Long, ar
ar = Blad1.Cells(4, 1).CurrentRegion
For j = 2 To UBound(ar)
  If ar(j, 2) - ar(j, 3) < 3 And ar(j, 4) <> "nvt" Then c00 = c00 & "|" & ar(j, 1)
Next j
ListBox1.List = Application.Transpose(Split(Mid(c00, 2), "|"))
End Sub

 

[pasan]

En mocht je lijst nou echt heeeeeeeeeeel lang worden is volgens mij de autoFilter het snelst....

Private Sub UserForm_Initialize()
Application.ScreenUpdating = False

 With Sheets("Blad1").Cells(4, 1).CurrentRegion
  .AutoFilter 2, "<3"
  .Offset(1).Copy Sheets("Blad1").Cells(20)
  .AutoFilter
 End With
 
ListBox1.List = Sheets("Blad1").Cells(1, 20).CurrentRegion.Value
Sheets("Blad1").Cells(1, 20).CurrentRegion.ClearContents

Application.ScreenUpdating = True
End Sub

 

[snb]

Lijkt me een klusje voor advancedfilter.

Ik heb eerst maar eens de taalfouten eruit gehaald: benodigd, tekort.
Toen de tabel op de juiste plaats gezet (vanaf cel A1).

Private Sub UserForm_Initialize()
  Blad1.Cells(2, 11) = "<4"
    
  Blad1.Cells(1).CurrentRegion.AdvancedFilter 2, Blad1.Cells(1, 11).CurrentRegion, Blad1.Cells(1, 13)
  ListBox1.List = Blad1.Cells(1, 13).CurrentRegion.Offset(1).Value
    
  Blad1.Cells(1, 13).CurrentRegion.Offset(1).ClearContents
End Sub

 

[jan excel]

Hallo allen,

Bedankt voor jullie scripts, denk hiermee wel verder te kunnen.
Zal hettesten im mijn project, als het goed werkt zal ik deze topic sluiten.


Groet,
Jan.

 

[VenA]

@pasan, volgens mij klopt dit niet .AutoFilter 2, "<3" maar goed:

Even een testje gedaan: 3 keer aselect de verschillende codes uitgevoerd op 10k records en dan lijkt jouw 'volgens mij' in #4 de juiste te zijn. De verschillen tussen het gebruik van het autofilter en een array zijn wel meetbaar maar niet echt storend. Het lusje van masc007 is al redelijk vertragend en waarom het geavanceerde filter van snb er zo lang overdoet vind ik wel bijzonder.

Just for fun even het bestandje bijgevoegd.

 

[pasan]

@ VenA op de userform staat "let op minder dan 3 op voorraad"...

 

[PLR]

Test klopt niet helemaal

@VenA je stopt de tellers te laat
bij bepaalde versie's wordt er nog hulp data gewist
tevens is de resultaat plaats wat ongelukkig gekozen.

zie aangepaste verzie

gr.

PLR

 

[VenA]

@pasan, je hebt het filter op kolom 2 staan en dat moet kolom 4 zijn. Vandaar de opmerking.

@PLR, In mijn optiek plaats je het resultaat van een timer altijd in de laatste regel van de code. Ook het wissen van hulpdata is onderdeel van een macro dus moet je meenemen om het vergelijk eerlijk te houden. Ik vind het wel bijzonder dat bij jou het geavanceerde filter als snelste uit het testje komt en bij mij nog steeds als veruit de langzaamste zelfs met jouw aanpassingen. Wat er ongelukkig is aan de locatie van het resultaat ontgaat mij even.

 

[jan excel]

Toch anders

Hoi Allen,

Achteraf gezien wil ik de vba script toch heel anders.
Zie bijlage, hopelijk is het voor jullie duidelijk hoe ik het wil hebben.
De regel totaal staat altijd onder de laatste regel van het materiaal.

Alvast bedankt.
Jan

 

[snb]

Wat schuift deze opdracht ?

 

[jan excel]

Hoi SNB,

Wat dacht je van lekkere fles wijn, voor de feestdagen.

Jan

 

[PLR]

@ VenA
Na testen alle reactie's was er niets aan de hand.
daarna nogmaals snb 's optie gedraaid ,
toen was ik de teller uitslag kwijt, snb gebruikt kolom 13-15

snb wist alle kolommen na kolom 12 Blad1.Cells(1, 13).CurrentRegion.Offset(1).ClearContents

Grt;

PLR