Controle datum in sheet in formulier

[Bas1980]

Hallo,

In het bijgevoegde bestand kan ik portofoons uit lenen. Als je klikt op 'portofoon uitlenen' kun je de portofoon aan mensen uitlenen welke in de sheet Personeel en cursussen staan.
In de sheet personeel en cursussen staan de namen van de mensen en de geldigheid van de cursussen. Nu wil ik graag bij het uitlenen van een portofoon de geldigheid van de cursussen checken en indien er een cursus verlopen is een popup geven dat een cursus verlopen is en dat men dat in de bijbehorende database dient te checken. Met welk stukje code kan ik dat doen?

Hetzelfde geld voor als de cursus nog een geldigheid heft van 30 dagen of minder.

Alvast dank!

Groetjes,

Bas

Bekijk bijlage Map101werkend.xlsm

 

[HSV]

En waar staat de geldigheidsduur van de cursus?

 

[Bas1980]

Hallo HSV

Die staat in het werkblad "personeel en cursussen" onder het kopje poortvideo, dus kolom G.
Ik moet er meerdere hebben maar dat kan ik daarna zelf wel invullen.

Groet,

Bas

 

[HSV]

Het is vandaag qua weer code geel/oranje, maar in kolom G t/m N is het alleen maar code rood.
Geen data dus.

 

[Bas1980]

HSV,

Code rood

Hierbij even een rij ingevuld en het bestand geupload.

Groetjes Bas.

Bekijk bijlage Map101werkend.xlsm

 

[HSV]

Test het maar eens Bas.

 

[Bas1980]

Allemachtig HSV! Schijnbaar is je kennis van vba zeer groot! Respect!
Ga ik vanavond even doen! Thanks!

Groet,

Bas

 

[Bas1980]

Zoiets bedoel ik idd! Alleen als ik nu een porto uit leen dan krijg ik de melding dat van het PSL nummer de datum is verlopen. Die moet juist 1 verder staan

 

[HSV]

Je vroeg "als iets een geldigheid van 30 dagen of minder heeft".

Dat gebeurt in de code.
Poortvideo was verlopen op 1 januari 2016.
Locatiepresentatie is verlopen op 2 maart 2017.

 

[Bas1980]

Klopt idd. Maar als de poortvideo is verlopen dan krijg ik als column het PSLnummer met datum van de poortvideo
Het moet de column van de poortvideo met de datum van de poortvideo zijn.

 

[HSV]

Zoe werkt het vast beter dan.

Private Sub Cnaam_AfterUpdate()
For j = 6 To 9
If IsDate(Cnaam.Column(j)) Then
   If CDate(Txtdatum.Value) + 30 > Cnaam.Column(j) Then msg = msg & Sheets("Personeel en cursussen").Cells(1, j [SIZE=3][COLOR=#0000ff]+ 1[/COLOR][/SIZE]).Value & " " & Cnaam.Column(j) & vbLf
 End If
 Next j
 If msg <> "" Then MsgBox msg & vbLf & "Verlopen"
End Sub

 

[Bas1980]

Ah... klopt. Ik had inderdaad al met wat gepuzzel uitgevonden dat als ik van de j een 6 maakte en verderop ergens een keer van de 6 een 7 maakte, dat ie het deed. +1 is er een om te onthouden.

Weet je ook hoe het komt, dat wanneer ik de code in een xsml probeer te plaatsen hij niets meer doet? Krijg dan de melding dat ie column o.i.d. niet kan vinden.

Groetjes Bas.

 

[HSV]

Wat is een xsml.

 

[Bas1980]

Xlsm..... sorry. Net wakker

 

[HSV]

.xlsm of .xlsb maakt voor de code niets uit (nog nooit iets over gelezen).
Stel dat je een nieuw bestand nog niet hebt opgeslagen is het nog steeds een .xlsx; daar werkt ook de code.

 

[Bas1980]

Ok. Zal vannacht weer ff aan de puzzel. Maar kreeg die melding van dat ie de column niet kon vinden. Ongeldig argument etc.hou jullie op de hoogte!

 

[HSV]

Heb je de code in een ander event gezet dan de after_update?

 

[Bas1980]

Nee dat niet. Precies in eerste instantie 1 op 1 over genomen. Zal het vannacht eens bekijken als ik je xlsb bestand opsla als xlsm of hij dan ook blijft werken.

 

[HSV]

Dit zijn natuurlijk geen handige codes.
Sowieso de blauwe regel niet.

Private Sub Cnaam_Change()
[COLOR=#0000ff]Dim Cnaam As Range[/COLOR]
 With Worksheets("Personeel en cursussen").Range("A1:A999999")
  Set Naam = .Find(Me.Cnaam.Value, LookIn:=xlValues)
   If Not Naam Is Nothing Then
     Me.Txtfirma = .Range("B" & Naam.Row).Value
   End If
End With
End Sub

Gooi die after_update eruit, en plaats onderstaande er eens weer voor terug, en verwijder bovenstaand code.

Private Sub Cnaam_Change()
if cnaam.listindex >0 then
 Txtfirma = Cnaam.Column(1)
    For j = 6 To 9
     If IsDate(Cnaam.Column(j)) Then
       If CDate(Txtdatum.Value) + 30 > Cnaam.Column(j) Then msg = msg & Sheets("Personeel en cursussen").Cells(1, j+1).Value & " " & Cnaam.Column(j) & vbLf
     End If
    Next j
 If msg <> "" Then MsgBox msg & vbLf & "Verlopen"
end if
End Sub

 

[Bas1980]

Hallo HSV,

Even ter update: Na dat ik het .xlsb bestand heb opgeslagen als .xlsm werkte de code perfect. Raar maar waar
Je tip van Dim Cnaam As Range zal ik nog door voeren. Aan het einde van het project loop ik er nogmaals doorheen om te kijken waar ik e.e.a. aan kan passen voor kortere of efficientere code.

Groetjes,

Bas