two Private Sub Worksheet_Change in on one sheet

Hi..

I have two macros i want to be activated by changes made on sheet..
i know they both work separately, but i cant get them to work together

the first is tricked by changes in column C:C
the other is tricked if there is entered and "X" in F:F

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strAddress As String
    Dim val
    Dim dtmTime As Date
    Dim Rw As Long
     
    If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
    
    dtmTime = Now()
    val = Target.Value
    strAddress = Target.Address
    
    Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
    With Sheets("Log Sheet")
        .Cells(Rw, 1) = strAddress
        .Cells(Rw, 2) = val
        .Cells(Rw, 3) = dtmTime
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
  
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim i As Integer

Dim Msg As String, Ans As Variant

i = Worksheets("Historik").Range("A1").CurrentRegion.Rows.Count
For x = 1 To 9999
   
If Cells(2 + x, 6) = "x" Then
If MsgBox("Er du sikker på at du vil flytte denne til historik?", vbYesNo, "Overfør til historik?") = vbYes Then
    z = z + 1
    Worksheets("Historik").Cells(i + z, 1).Value = Cells(2 + x, 1)
    Worksheets("Historik").Cells(i + z, 2).Value = Cells(2 + x, 2)
    Worksheets("Historik").Cells(i + z, 3).Value = Cells(2 + x, 3)
    Worksheets("Historik").Cells(i + z, 4).Value = Cells(2 + x, 5)

Call UpdateAction

End If
End If

Next

Call slet_x

Application.ScreenUpdating = True

End Sub

Can any on help?

Copy everything in between Private Sub ... End Sub of the 2nd code and paste it at the end of the 1st code.

Then change the If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub to
If Intersect(Target, Range("C:C")) Is Nothing Then
...
End If

e.g. (untested)

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strAddress As String
    Dim val
    Dim dtmTime As Date
    Dim Rw As Long
     
    If Intersect(Target, Range("C:C")) Is Nothing Then
    
        dtmTime = Now()
        val = Target.Value
        strAddress = Target.Address
        
        Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
        With Sheets("Log Sheet")
            .Cells(Rw, 1) = strAddress
            .Cells(Rw, 2) = val
            .Cells(Rw, 3) = dtmTime
        End With
    End If
    
    Application.ScreenUpdating = False
  
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim i As Integer
    
    Dim Msg As String, Ans As Variant
    
    i = Worksheets("Historik").Range("A1").CurrentRegion.Rows.Count
    For x = 1 To 9999
       
    If Cells(2 + x, 6) = "x" Then
    If MsgBox("Er du sikker på at du vil flytte denne til historik?", vbYesNo, "Overfør til historik?") = vbYes Then
        z = z + 1
        Worksheets("Historik").Cells(i + z, 1).Value = Cells(2 + x, 1)
        Worksheets("Historik").Cells(i + z, 2).Value = Cells(2 + x, 2)
        Worksheets("Historik").Cells(i + z, 3).Value = Cells(2 + x, 3)
        Worksheets("Historik").Cells(i + z, 4).Value = Cells(2 + x, 5)
    
    Call UpdateAction
    
    End If
    End If
    
    Next
    
    Call slet_x
    
    Application.ScreenUpdating = True

End Sub

it dosent work.. but maybe the macro with C:C is wrong?
I want it to trick if i change or enter a date in C:C

Ahh, sorry, missed a step. Added a "Not" at the If statement.

e.g. (untested)

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strAddress As String
    Dim val
    Dim dtmTime As Date
    Dim Rw As Long
     
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
    
        dtmTime = Now()
        val = Target.Value
        strAddress = Target.Address
        
        Rw = Sheets("Log Sheet").Range("A" & Rows.Count).End(xlUp).Row + 1
        With Sheets("Log Sheet")
            .Cells(Rw, 1) = strAddress
            .Cells(Rw, 2) = val
            .Cells(Rw, 3) = dtmTime
        End With
    End If
    
    Application.ScreenUpdating = False
  
    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim i As Integer
    
    Dim Msg As String, Ans As Variant
    
    i = Worksheets("Historik").Range("A1").CurrentRegion.Rows.Count
    For x = 1 To 9999
       
    If Cells(2 + x, 6) = "x" Then
    If MsgBox("Er du sikker på at du vil flytte denne til historik?", vbYesNo, "Overfør til historik?") = vbYes Then
        z = z + 1
        Worksheets("Historik").Cells(i + z, 1).Value = Cells(2 + x, 1)
        Worksheets("Historik").Cells(i + z, 2).Value = Cells(2 + x, 2)
        Worksheets("Historik").Cells(i + z, 3).Value = Cells(2 + x, 3)
        Worksheets("Historik").Cells(i + z, 4).Value = Cells(2 + x, 5)
    
    Call UpdateAction
    
    End If
    End If
    
    Next
    
    Call slet_x
    
    Application.ScreenUpdating = True

End Sub

[/QUOTE]

one more question
Can i add a .Cells(Rw, 4) = the thing written in A

maybe you know how to do that

Thanks a lot! it works just like i want i to !

Not a problem. Thanks for the rep!

thing written in A? as in, for example, of Rw = 100, cell D100 takes the same value as A100?

If so, .Cells(Rw, 4) = .Cells(Rw,1)

In fx. D100 i want it to type the same value as A100 from the sheet which the macro is in.. now i takes the value from "Log Sheet"

yes.. but it takes the value from the wrong sheet..

Ahh, got it. Try this instead:


.Cells(Rw, 4) = Cells(Rw,1)
I removed a dot before Cells(Rw,1)

it dosent return anything :/ hmm

I think I know what you're trying to do. You want to insert the value in column A of the cell that changed. Try this

.Cells(Rw, 4) = Cells(Target.Row,1)

Thanks!! :d :d

You're welcome. Thanks for the rep!