Excel VBA timestamp laatste wijziging rij

[zipke1988]

Experts,

Mijn Excel registreert in elke rij de datum van laatste wijziging. Deze datum wordt in kolom F geplaatst en begint op de tweede rij (eerste rij zijn kolomtitels).

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Cells(Target.Row, "F") = Date
Columns("F").AutoFit
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

Nu heb ik drie vragen:
1) Ik wil niet enkel een afbeelding van de datum, maar ook van de tijd van laatste wijziging. Beide in dezelfde cel is ok, tijd in een andere cel is ook goed. Indien mogelijk zou het fijn zijn, moesten jullie mij beide codes kunnen geven.
2) Ik wil een automatische registratie van de user die de Excelrij heeft gewijzigd. Deze initialen van users zitten in kolom C.
3) Kan ik de range ingeven waarvoor deze registratie van wijziging wordt bepaald? De tabel met rijen loopt van kolom A tot E. Wanneer hier iets in wordt gewijzigd, wordt de datum automatisch ingevuld in kolom F. Nu is mijn vraag, als ik iets verander aan de Excel, bv. kolom G (niet in mijn tabel), dan wil ik niet dat de datum van wijziging in kolom F wordt aangepast. De ruimte buiten A:E zou dus een "vrije" ruimte moeten zijn waar ik zaken mag veranderen zonder dat er iets geregistreerd wordt van "laatste wijziging".

Indien mijn vragen niet duidelijk zijn, laat gerust iets weten.

Alvast heel erg bedankt!

 

[Gerard2348]

op je eerste vraag verander

Cells(Target.Row, "F") = Date

in

Cells(Target.Row, "F") = Now()

op vraag 2

Cells(Target.Row, "G") = Application.UserName

voor de user in kolom G

 

[Timshel]

Vraag 3:

If Target.Row = 1 Or Target.Row > 5 Then Exit Sub

 

[zipke1988]

op je eerste vraag verander

Cells(Target.Row, "F") = Date

in

Cells(Target.Row, "F") = Now()

Dit werkt jammer genoeg niet. Op welke format moet ik de celeigenschappen zetten? Ze staan nu natuurlijk op datum, op wat moet ik dit zetten dan?

op vraag 2

Cells(Target.Row, "G") = Application.UserName

voor de user in kolom G

Dit werkt, maar is nu de volledige naam. Is het mogelijk hier louter de initialen te krijgen?

 

[zipke1988]

Vraag 3:

If Target.Row = 1 Or Target.Row > 5 Then Exit Sub

Ik denk dat je hier bedoelt Or Target.Column > 5, niet? Gezien ik het had over kolommen?
Hoe moet ik deze code dan invoeren, want onderstaande lukt niet.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Or Target.Column > 5 Then Exit Sub
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Cells(Target.Row, "F") = Date
Columns("F").AutoFit
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

 

[Gerard2348]

probeer je cel eigenschappen eens op

d-m-jjjj uu:mm

te zetten

 

[Timshel]

Lukt niet?
Check even mijn in de gauwigheid in elkaar gedraaide voorbeeld (wat jij als vrager natuurlijk had moeten maken, maar goed).
De target.column > 5-clausule werkt hier prima.
Tevens heb ik de tijd/datum-opmaak van kolom F geregeld, dus kijk even hoe dat gedaan is.
Ook heb ik iets bedacht voor het weergeven van initialen. Hou er wel rekening mee dat gebruikers hun applicatienaam gemakkelijk kunnen wijzigen.

 

[zipke1988]

Lukt niet?
Check even mijn in de gauwigheid in elkaar gedraaide voorbeeld (wat jij als vrager natuurlijk had moeten maken, maar goed).
De target.column > 5-clausule werkt hier prima.
Tevens heb ik de tijd/datum-opmaak van kolom F geregeld, dus kijk even hoe dat gedaan is.
Ook heb ik iets bedacht voor het weergeven van initialen. Hou er wel rekening mee dat gebruikers hun applicatienaam gemakkelijk kunnen wijzigen.

Het werkt perfect! Hartelijk dank -ook al was uw sarcasme niet echt nodig.

Bedankt ook voor het extra stukje van de initialen.

Nog een zeer belangrijke vraag echter: wanneer men een nieuw lijn begint (alle informatie invult), komen automatisch de initialen en de datum in de Excel te staan.
Wanneer deze lijn -door een fout- moet verwijderd worden, blijven deze initialen en datum staan, hetgeen uiteraard niet de bedoeling mag zijn. Moet ik nog een stukje toevoegen in de aard van "als kolom A = leeg, dan initialen en datum ook leegmaken"? Kolom A zal sowieso ingevuld worden als een lijn wordt toegevoegd. Het is onmogelijk dat een lijn informatie bevat als kolom A leeg is (dus dit zou een goede controle te zijn om VBA aan te sturen).

Hartelijk dank

 

[VenA]

bv zo. Met in plaats van de gebruikersnaam de windows login als gebruikersnaam.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Or Target.Column > 5 Or Target.Count <> 1 Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        If Cells(Target.Row, 1) = "" Then
            Target.Resize(, 7).ClearContents
          Else
            Cells(Target.Row, "F").Resize(, 2) = Array(Now, Initialen(Environ("UserName")))
            Columns("F").AutoFit
        End If
        .EnableEvents = True
    End With
End Sub

 

[Timshel]

Op iets dergelijks kwam ik ook uit:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Or Target.Column > 5 Or Len(Target.Address) = 5 Then Exit Sub
    With Application
        .EnableEvents = False
        If Trim(Join(.Transpose(.Transpose(Cells(Target.Row, 1).Resize(, 5))))) = "" Then
            Cells(Target.Row, 6).Resize(, 2).ClearContents
        Else
            Cells(Target.Row, "F") = Now
            Cells(Target.Row, "G") = Initialen(.UserName)
            Columns("F").AutoFit
        End If
        .EnableEvents = True
    End With
End Sub

Private Function Initialen(Nm As String) As String
    Dim i As Long
    
    Initialen = Left(Nm, 1)
    For i = 2 To Len(Nm)
        If Mid(Nm, i, 1) = " " Then Initialen = Initialen & Mid(Nm, i + 1, 1)
    Next
End Function

De voorwaarde

Len(Target.Address) = 5

is omdat de Change-event ook getriggerd wordt bij het verwijderen van een hele regel.

Ik bedoelde geen sarcasme. Laat ik het zo formuleren: plaats de volgende keer graag een voorbeeldbestand zodat helpers dat niet zelf hoeven te maken.

 

[zipke1988]

...

Vooreerst mijn excuses dan. Ik gebruik ook andere softwaretoepassingen en op die fora is het soms "not done" om een bestand te uploaden (virussen ed.), vandaar dat ik geen had geüpload en het zo goed mogelijk had proberen verwoorden.

Ik heb heel jouw code gekopieerd en het werd perfect. Ik zou het uiteraard graag begrijpen wel

If Target.Row = 1 Or Target.Column > 5 Or Len(Target.Address) = 5 Then Exit Sub

Waarom lengte 5? 5 Karakters? Vanaf dat Cel A leeg is, mag de lijn verwijderd worden. Wat wil deze 5 dan zeggen?

If Trim(Join(.Transpose(.Transpose(Cells(Target.Row, 1).Resize(, 5))))) = "" Then
            Cells(Target.Row, 6).Resize(, 2).ClearContents

Mijn excuses, ik ben helemaal nieuw in VBA.

Alvast bedankt!

 

[Timshel]

Vraag 1. Target.Address is het adres van de gemuteerde cel, bijvoorbeeld "$A$2". Deze tekenreeks bestaat uit 4 tekens. Als je een hele rij verwijdert, bijvoorbeeld rij 4, ziet Target.Address er zo uit: "$4:$4" en heeft het 5 tekens. Dan wil ik niet dat de code wordt uitgevoerd. Deze truc werkt alleen tot en met rij 9 bedenk ik mij nu. Het zou bij nader inzien zoiets moeten worden:

If Target.Row = 1 Or Target.Column > 5 Or Target.Count > 10 Then Exit Sub

Vraag 2. De coderegel

Trim(...

voegt de cellen uit kolom A tot en met E van de betreffende rij samen en kijkt of deze gevuld zijn, anders dan met spaties. Alleen als alle leeg zijn worden ook kolom F en G in die rij gewist. Dat was niet gevraagd zag ik later.
De eerlijkheid gebiedt mij te zeggen dat de code van VenA uit #9 beter aansluit bij je vraag.

 

[zipke1988]

...

...

Bedankt voor de informatie.

Ik wil best de code van VenA kopiëren, maar ik weet niet hoe ik ze moet aanpassen naar mijn eigen document. En momenteel worden de initialen niet op de juiste locatie ingeput.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Or Target.Column > 5 Or Target.Count <> 1 Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        If Cells(Target.Row, 1) = "" Then
            Target.Resize(, 7).ClearContents
          Else
            Cells(Target.Row, "F").Resize(, 2) = Array(Now, Initialen(Environ("UserName")))
            Columns("F").AutoFit
        End If
        .EnableEvents = True
    End With
End Sub

Mijn tabel met informatie is 5 kolommen breed.
In de 6de kolom wordt automatisch de Now() ingevuld.
In de 4de kolom worden de initialen ingevuld.

Met de formule van VenA worden de initialen in kolom 4 ("D") ingevuld, maar ik zie nergens in zijn formule een verwijzing naar "4" of naar "D".

Weet jij hoe ik de code moet aanpassen?

Vriendelijk bedankt!

 

[Timshel]

Ik begrijp niet dat de initialen bij jou in kolom D terechtkomen. Deze regel:

Cells(Target.Row, "F").Resize(, 2) = Array(Now, Initialen(Environ("UserName")))

bepaalt dat de tijd en de initialen respectievelijk in kolom F en kolom G terechtkomen. Dat is ook wat in het voorbeeld gebeurt:

 

[zipke1988]

...

Neen, je begrijpt mij verkeerd. In mijn oorspronkelijke document kwamen deze terecht in kolom F, maar ik heb mijn kolommen van plaats gewisseld.
Jouw code heb ik ook aangepast naar mijn nieuwe kolommen en dit werkt perfect.
Maar nu tracht ik de code van VenA aan te passen naar mijn kolommen (initialen in D en datum in F). Maar dat lukt mij dus niet, gezien ik de code niet begrijp.
Mijn huidige code is:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Or Target.Column > 6 Then Exit Sub
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Cells(Target.Row, "F") = Now
    Cells(Target.Row, "D") = Initialen(Application.UserName)
    Columns("F").AutoFit
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Private Function Initialen(Nm As String) As String
    Dim i As Long
    
    Initialen = Left(Nm, 1)
    For i = 2 To Len(Nm)
        If Mid(Nm, i, 1) = " " Then Initialen = Initialen & Mid(Nm, i + 1, 1)
    Next
End Function

En nu probeer ik de code van VenA ook toe te voegen, maar als ik zijn code kopiëer, komen de initialen in kolom G, maar ze moeten dus in kolom D komen. Begrijp je?
En ik begrijp de code van VenA niet, dus kan het niet zelf aanpassen.

Bedankt

 

[VenA]

Wat is er nu zo moeilijk aan?

Deze regel aanpassen in het geheel wat je zelf al bedacht hebt.

Cells(Target.Row, "F").Resize(, 2) = Array(Now, Initialen(Environ("UserName")))

moet dan worden

Cells(Target.Row, "F") = Now
Cells(Target.Row, "D") = Initialen(Application.UserName)

 

[zipke1988]

...

Als ik het allemaal "zo eenvoudig had gevonden", had ik jullie hulp niet moeten inroepen he. Ik heb nog nooit met VBA gewerkt maar moet dit nu even kunnen invoeren voor het werk.
Bedankt voor de uitleg.

Jouw code geeft wel als resultaat dat telkens de eerste kolom moet ingevuld worden, anders neemt hij geen tekst aan (hij wist het dan ook weer automatisch - gezien kolom A leeg is) - wat eigenlijk logisch is, gezien de geschreven code. Niet bijzonder handig wel.

Hebben jullie een andere oplossing eventueel? Ik zou gewoon lijnen moeten kunnen verwijderen, zonder dat de automatisch ingevulde initialen en timestamp blijven staan. That's all. Enig idee?


Dank bij voorbaat

 

[Timshel]

Als je de hele rij leeg wil maken door alleen de cel in kolom A te wissen, dan betekent dat ook dat de cel in kolom A gevuld moet zijn voordat Initiaal en Timestamp gevuld worden.
Daar is mogelijk wel omheen te programmeren door toetsaanslagen af te vangen, maar dat wordt veel te complex.

Probeer het nog eens met mijn code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row = 1 Or Target.Column > 5 Or Target.Count > 10 Then Exit Sub
    With Application
        .EnableEvents = False
        If Trim(Join(.Transpose(.Transpose(Cells(Target.Row, 1).Resize(, 3))))) = "" Then
            Cells(Target.Row, 6).Resize(, 2).ClearContents
        Else
            Cells(Target.Row, "F") = Now
            Cells(Target.Row, "D") = Initialen(.UserName)
            Columns("F").AutoFit
        End If
        .EnableEvents = True
    End With
End Sub

Private Function Initialen(Nm As String) As String
    Dim i As Long
    
    Initialen = Left(Nm, 1)
    For i = 2 To Len(Nm)
        If Mid(Nm, i, 1) = " " Then Initialen = Initialen & Mid(Nm, i + 1, 1)
    Next
End Function

 

[zipke1988]

...

Ik heb absoluut geen idee wat je veranderd hebt, maar het werkt!!

Hartelijk dank aan beiden! Top!!

 

[zipke1988]

...

Timshel, mag ik je nog een laatste iets vragen - volgens mij is het daarna volledig klaar.
Ik zou twee kolommen willen blokkeren voor de gebruikers, zodat ze enkel aanpasbaar zijn door mensen die het wachtwoord kennen.

Kolommen D (initialen) en F (timestamp) worden nu automatisch ingevuld door de code.
Kolommen H en I worden manueel ingevuld en zouden moeten geblokkeerd worden voor iedereen - enkel aan te passen en te deblokkeren met een code.

VBA geeft mij echter een foutmelding door de code "autofit".

Ik gebruik volledig jouw code:

        Private Sub Worksheet_Change(ByVal Target As Range)
            If Target.Row = 1 Or Target.Column > 5 Or Target.Count > 10 Then Exit Sub
            With Application
                .EnableEvents = False
                If Trim(Join(.Transpose(.Transpose(Cells(Target.Row, 1).Resize(, 3))))) = "" Then
                    Cells(Target.Row, 6).Resize(, 2).ClearContents
                Else
                    Cells(Target.Row, "F") = Now
                    Cells(Target.Row, "D") = Initialen(.UserName)
                    Columns("F").AutoFit
                End If
                .EnableEvents = True
            End With
        End Sub

        Private Function Initialen(Nm As String) As String
            Dim i As Long
            
            Initialen = Left(Nm, 1)
            For i = 2 To Len(Nm)
                If Mid(Nm, i, 1) = " " Then Initialen = Initialen & Mid(Nm, i + 1, 1)
            Next
        End Function

Bij deze lijn krijg ik een aanduiding dat het daar verkeerd loopt.

Columns("F").AutoFit

Weet jij hoe ik dit kan voorkomen?
Ik deblokkeer nu alle cellen en blokker de kolommen H en I en "beveilig blad".

Wederom alvast hartelijk bedankt!