Automatisch datum plaatsen in B2 als cel B1 is gevuld

Status
Niet open voor verdere reacties.

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
953
Besten mensen,

Onderstaande code moet volgens mij juist zijn echter werkt deze niet (in Excel 2010). Kan het zijn dat ik een instelling niet juist heb, of is de code gewoonweg niet juist.

Het is mijn bedoeling dat wanneer ik cel B1 vul, in B2 automatisch de datum van vandaag gevuld wordt. Het is niet de bedoeling dat de datum iedere dag wordt aangepast.

Alvast bedankt.

Groeten, Robert


Private Sub Workbook_Open()
If Sheets("Blad1").Range("B1") = "" Then
Sheets("Blad1").Range("B2") = Date
End If
End Sub
 
Laatst bewerkt:
Als je B1 gaat vullen.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
  If .Address(0, 0) = "B1" And Not IsEmpty(Target) Then
     .Offset(1) = Date
Else
     .Offset(1).ClearContents
    End If
  End With
Application.EnableEvents = True
End Sub
 
Harry bedankt,

Ik ga morgen op het werk gelijk kijken of het werkt. Nu vraag ik mij af of ik de macro op dezelfde locatie kan plaatsen als de gewoonlijke macro's die je bijv. door een knop aanstuurt.

Bovendien bedacht ik mij later dat het handiger zou zijn dat het niet alleen om cel b1 gaat maar de hele kolom b vanaf de 2e regel. Kan ik dat wijzigen door b2:b?

Graag hoor ik van jou.

Groeten, Robert
 
Harry,

ik kon de macro toch thuis testen en werkt perfect, maar hoe kun je de datum in kolom c zetten i.p.v. kolom b2? Offset betekent volgens mij één cel naar onderen, dus nu zou ik graag willen weten hoe je deze op kolom c plaatst.

Sorry voor het ongemak.

Groeten, Robert
 
Zo dan.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
  If .Column = 2 And Not Target.Address(0, 0) = "B1" And Not IsEmpty(Target) Then
     .Offset(, 1) = Date
Else
     .Offset(, 1).ClearContents
    End If
  End With
Application.EnableEvents = True
End Sub
 
bedankt helemaal top

Harrie,

bedankt....de code werkt perfect.

fijne avond,

Robert
 
Helaas, ik kwam ergens achter, wanneer eenmaal automatisch de datum van vandaag is geplaatst en ik na een dag hier weer iets in zet veranderd de datum weer en dat is niet de bedoeling.

Bovendien wil ik naast deze code een zelfde code gebruiken voor anderen kolommen, hiermee bedoel ik dat ik hier meerdere opdrachten in wil zetten. Ik heb hiervoor de hele code gekopieerd en de waarden aangepast, maar dat werkt niet. Hoe kan ik meerdere opdrachten kwijt.
 
Probeer deze eens Robert.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
  If Not IsEmpty(Target) And IsEmpty(.Offset(, 1)) Then .Offset(, 1) = Date
  End With
Application.EnableEvents = True
End Sub
 
Harry, bedankt. Dit is eigenlijk niet wat ik bedoel. In jouw voorstel zou het altijd en overal werken, maar in mijn geval betreft het maar een paar keer, zie voorbeeld hieronder, echter werkt deze niet. Misschien heb jij hiervoor een oplossing.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column = 2 And Not Target.Address(0, 0) = "b1" And Not IsEmpty(Target) Then
.Offset(, 1) = Date
Else
.Offset(, 1).ClearContents
End If
If .Column = 4 And Not Target.Address(0, 0) = "d1" And Not IsEmpty(Target) Then
.Offset(, 1) = Date
Else
.Offset(, 1).ClearContents
End If
If .Column = 6 And Not Target.Address(0, 0) = "f1" And Not IsEmpty(Target) Then
.Offset(, 1) = Date
Else
.Offset(, 1).ClearContents
End If
Application.EnableEvents = True
End Sub
 
Ik heb er nog een klein verzoek aan toegevoegd, onderstaande code werkt helaas deels (het laatste gedeelte) niet, wat doe ik fout?

[SQL]Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column = 8 And Not Target.Address(0, 0) = "h1" And Not IsEmpty(Target) Then
.Offset(, 1) = Date
Else
.Offset(, 1).ClearContents
End If

If .Column = 4 And Not Target.Address(0, 0) = "d1" And Not IsEmpty(Target) Then
.Offset(, 1) = "L0"
Else
Rem .Offset(, 1).ClearContents
End If

Dim it As Range
For Each it In ActiveSheet.Range("L1:L100")
If it = "Uitstel" And Not IsEmpty(Target) Then
.Offset(, 5) = Date
Else
.Offset(, 5).ClearContents
End If
Next
End With
Application.EnableEvents = True
End Sub[/SQL]
 
Maak een .xls of .xlsm bestandje met wat je bedoeld.
 
een bestand toegevoegd

Bekijk bijlage test.xlsm

Dag Harrie, ik hoop dat het lukt.

Bij de code heb ik een vermelding gemaakt wat de functie is, samen met het voorbeeld hoop ik dat het lukt.

Alvast hartelijk bedankt, zou je erg dankbaar zijn als het lukt.

Groeten, Robert
 
Laatst bewerkt:
Dag Robert,

Test het eens.
 

Bijlagen

puntjes op de ï

Bekijk bijlage test 2.xlsm

Dag Harry,

Ik ben enorm blij dat alles het voor 90% doet, nu nog de resterende 10%.

Hierbij voeg ik het officiele programma toe, de vorige was een Dummy. Het programma werkt op een paar kleinigheden na. Ik heb de code aangepast aan het officiele programma en per activiteit heb ik tekst en uitleg wat deze moet doen, echter in sommige gevallen werkt het niet en krijg ik een foutmelding. Bij de verantwoordelijke fout heb ik een remark geplaatst.

Het vreemde wat zich voor doet is dat wanneer ik eenmaal een foutmelding krijg de de gehele code niet meer werkt. Eerst wanneer ik de pc opnieuw opstart doet deze het weer en aangezien ik het bij mij op het werk gebruik duurt dat al gauw ruim 15 minuten. Wat kan ik hier aan doen dat de code te allen tijde na een foutmelding het weer doet zonder de pc opnieuw op te hoeven starten.

Alvast bedankt en een fijn weekend.

Groeten, Robert
 
Laatst bewerkt:
Het eerste zal ik direct even beantwoorden als er een fout komt, maar zal dit later proberen te verhelpen zodat deze melding niet verschijnt.
Excel gewoon afsluiten en opnieuw opstarten.
Niet je gehele pc. ;)

Ik kijk er morgen pas naar denk ik, ga zo douchen en weg.
 
Helaas werkt het niet als ik excel afsluit, dat had ik idd al geprobeerd (ben wel blond hahaha). In een enkel geval werkt het maar doorgaans niet, heeft waarschijnlijk met een instelling te maken.
 
Wat ik ook vaak doe.
Vanaf de geel gemarkeerde regel even met de muis terug naar "application.enableevents = false".
Deze even op 'true' zetten, en de code loopt weer door om te testen.
 
bedoel je bij Eigenschappen blad 1, daar staat application.enableevents niet bij, weet je misschien waar ik deze kan vinden?
 
Test het eens Robert.
 

Bijlagen

Harry, bedankt.

De code werkt bijna helemaal goed, een paar dingetjes kon ik zelf oplossen alleen niet hoe ik met de cursur in kolom E naast "L0" kan komen te staan, ik moet deze nl. met een getal handmatig aanvullen bijv. "L01". Nadat ik deze heb gevuld moet de cursur idd naar kolom H.

Ik ben hier al heel blij mee en dat gaat mij straks heel veel tijd en fouten schelen en ben jou echt dankbaar dat je me zo goed hebt geholpen.

Een antwoord zie ik met belangstelling tegemoet.

Robert
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan