Excel. Dato hvis en celle er i brug

Går ud fra du fik dit svar i den anden tråd lige før ? :)

Hehe ja kunne ikke lige finde den først...... Men du havde ret..... Med at den skifter dato..... Havde du noget andet...... Jeg har selv en der virker men har brug for at fra "E1" kommer dato i "D1" og det går den..... Men vil også gøre det samme med "L1" og dato i "M1"


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Columns("E:E")) Is Nothing Then
    If Not IsEmpty(Target) Then
        Target.Offset(0, -1).Value = Now
    Else
        Target.Offset(0, -1).ClearContents
    End If
End If
End Sub<

Prøv lige det her, så indsættes dags dato i celle i kolonne C, hvis der sker en ændring i kolonne D, og altid i den celle i C, som er ud for cellen i kolonne D, hvor ændringen er sket! Dato ændres så hver gang du ændrer på værdien i D, også selvom du sletter værdien, indsættes dato, og den overskriver gammel dato :) Håber det kan bruges...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'denne makro gemmer aktiv celles nummer i kolonne A

Dim c As Range
               
        Set c = Range("a1", Range("a2").End(xlDown)).Find(Empty, LookIn:=xlValues)
           
            c = Range("b" & (ActiveCell.Row)).Value

    Range("A1") = Range("A1:A3").Find(Empty, LookIn:=xlValues).Offset(-1, 0)

If Range("a2") <> "" Then Range("a2") = ""

End Sub

Sub Worksheet_Change(ByVal Target As Range)

'denne makro indsætter dato i kolonnne C når der sker ændringer i kolonne D,
'uanset om værdier slettes eller tilføjes.

Dim Kol As Range
Dim IntersectRange As Range
Dim c As Range
   
   
   
    Set c = Range("a1", Range("a3").End(xlDown)).Find(Empty, LookIn:=xlValues)
    Set Kol = Columns("D") 'du kan selv ændre "D" til den/ de kolonner, som
    'hvis der sker ændringer, påvirker indsættelse af dato. Hvis du vil have det
    'sker for flere kolonner, f.eks. D til F, udskift columns("D") med Range("D:F")
   
    Set IntersectRange = Intersect(Target, Kol)
   
If IntersectRange Is Nothing Then

    Else
   

DitValg = Date

    Range("C" & (Cells(1, 1).Value)) = DitValg
        'du kan selv ændre "C" til den kolonne du vil have datoen i
   

End If
End Sub

Hov husk lige at du er nødt til at skive tal i kolonne B, altså B1=1, B2=2, B3=3, osv. dernedad! Ellers kører det ikke! Men du kan jo bare "trække" tallene ned, for de rækker som du skal bruge, det er nemt og hurtigt! :) Du kan evt. sætte kolonne A og B's bredde til 0 for at gemme disse hjælpekolonner...

hvis du bruger denne her så slettes datoen fra cellen i C hvis du sletter værdien i D:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'denne makro gemmer aktiv celles nummer i kolonne A

Dim c As Range
               
        Set c = Range("a1", Range("a2").End(xlDown)).Find(Empty, LookIn:=xlValues)
           
            c = Range("b" & (ActiveCell.Row)).Value

    Range("A1") = Range("A1:A3").Find(Empty, LookIn:=xlValues).Offset(-1, 0)

If Range("a2") <> "" Then Range("a2") = ""

End Sub

Sub Worksheet_Change(ByVal Target As Range)

'denne makro indsætter dato i kolonnne C når der sker ændringer i kolonne D,
'uanset om værdier slettes eller tilføjes.

Dim Kol As Range
Dim IntersectRange As Range
Dim c As Range
   
   
   
    Set c = Range("a1", Range("a3").End(xlDown)).Find(Empty, LookIn:=xlValues)
    Set Kol = Columns("D") 'du kan selv ændre "D" til den/ de kolonner, som
    'hvis der sker ændringer, påvirker indsættelse af dato. Hvis du vil have det
    'sker for flere kolonner, f.eks. D til F, udskift columns("D") med Range("D:F")
   
    Set IntersectRange = Intersect(Target, Kol)
 

 
If IntersectRange Is Nothing Then

    Else
   

DitValg = Date

    Range("C" & (Cells(1, 1).Value)) = DitValg
        'du kan selv ændre "C" til den kolonne du vil have datoen i
   
If IntersectRange = "" Then Range("C" & (Cells(1, 1).Value)) = ""
 
 
End If

End Sub

Jeg ved ikke hvorfor men jeg kan ikke få din til at virke......
Jeg fandt lidt her og der på nettet og fik tilsidst en brugbar løsning.......

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Columns("E:E")) Is Nothing Then
    If Not IsEmpty(Target) Then
        Target.Offset(0, -1).Value = Now
    Else
        Target.Offset(0, -1).ClearContents
    End If
End If


If Target.Count > 1 Then Set Target = Target.Cells(1, 1)
If Not Intersect(Target, Columns("L:L")) Is Nothing Then
    If Not IsEmpty(Target) Then
        Target.Offset(0, 1).Value = Now
    Else
        Target.Offset(0, 1).ClearContents
    End If
End If
End Sub

Den virker for mig....... Du skal ha mange tak for hjælpen . Point til dig

Jamen det er nok også en bedre løsning din egen, min er lidt "alternativ" men fik det til at virke :) Go dag