Wolfgang7
11-17-2020, 03:16 AM
Hi,
I have table where new entries hav to made
With the intersect mehodI manage to register the chngd lines after a cell has changed.
Now there is the requirement to sort the tabe after each new entry
and to stay after sorting in the active cell for further entries inthe same line.
I've tried it with temporary comment (see below), but i's hard :-(
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:W5000")) Is Nothing Then
'Range muss evtl. erweitert werden...
If Target.Column <> 24 Then
'Aenderungsinfo:
'Cells(Target.Row, 24)-> 24 steht für Spalte W, "Datum/Zeit/User,
'muss bei Spalttenverschiebung angepasst werden.
Cells(Target.Row, 24) = Now & " " & Environ("Username")
End If
'aktive Zelle mit Kommentar "marke" versehen
'Range (Application.PreviousSelections(1).Address)
'Range(ActiveCell.Address).Select
Range(ActiveCell.Address).AddComment
Range(ActiveCell.Address).Comment.Text Text:="marke"
'Sortierung:
'Bereich, auf den sich die Sortierung auswirken soll
Range("A4:W5000").Select
'Sortierkriterien
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
I have table where new entries hav to made
With the intersect mehodI manage to register the chngd lines after a cell has changed.
Now there is the requirement to sort the tabe after each new entry
and to stay after sorting in the active cell for further entries inthe same line.
I've tried it with temporary comment (see below), but i's hard :-(
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:W5000")) Is Nothing Then
'Range muss evtl. erweitert werden...
If Target.Column <> 24 Then
'Aenderungsinfo:
'Cells(Target.Row, 24)-> 24 steht für Spalte W, "Datum/Zeit/User,
'muss bei Spalttenverschiebung angepasst werden.
Cells(Target.Row, 24) = Now & " " & Environ("Username")
End If
'aktive Zelle mit Kommentar "marke" versehen
'Range (Application.PreviousSelections(1).Address)
'Range(ActiveCell.Address).Select
Range(ActiveCell.Address).AddComment
Range(ActiveCell.Address).Comment.Text Text:="marke"
'Sortierung:
'Bereich, auf den sich die Sortierung auswirken soll
Range("A4:W5000").Select
'Sortierkriterien
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub