macro korter schrijven?

[jpvs]

Is het mogelijk dit korter te maken:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If Application.WorksheetFunction.CountIf(Range("C:C"), Target.Value) = 1 Then
            Sheets("Blad1").Range("J65536").End(xlUp).Offset(1, 0).Value = Target.Value
        End If
    End If
    
   If Not Intersect(Target, Range("D:D")) Is Nothing Then
        If Application.WorksheetFunction.CountIf(Range("D:D"), Target.Value) = 1 Then
            Sheets("Blad1").Range("K65536").End(xlUp).Offset(1, 0).Value = Target.Value
        End If
    End If
    
  If Not Intersect(Target, Range("E:E")) Is Nothing Then
        If Application.WorksheetFunction.CountIf(Range("E:E"), Target.Value) = 1 Then
            Sheets("Blad1").Range("L65536").End(xlUp).Offset(1, 0).Value = Target.Value
        End If
    End If
End Sub

Dank bij voorbaat,

Pierre

 

[Wigi]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, rngInters As Range
    On Error Resume Next
    Set rngInters = Application.Intersect(Target, Range("C1:E1").EntireColumn)
    For Each rng In rngInters
        If WorksheetFunction.CountIf(rng.EntireColumn, rng.Value) = 1 Then
            Sheets("Blad1").Cells(Rows.Count, rng.Column + 7).End(xlUp).Offset(1).Value = Target.Value
    Next
End Sub

ongeteste code

Wigi

 

[jpvs]

Wigi,


Thanks werkt perfect,
If moest alleen nog afgesloten worden met End If.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, rngInters As Range
    On Error Resume Next
    Set rngInters = Application.Intersect(Target, Range("C1:E1").EntireColumn)
    For Each rng In rngInters
        If WorksheetFunction.CountIf(rng.EntireColumn, rng.Value) = 1 Then
            Sheets("Blad1").Cells(Rows.Count, rng.Column + 7).End(xlUp).Offset(1).Value = Target.Value
End If    
Next
End Sub

Pierre

 

[Wigi]

If moest alleen nog afgesloten worden met End If.

Of in mijn code:

If WorksheetFunction.CountIf(rng.EntireColumn, rng.Value) = 1 Then

aanvullen tot

If WorksheetFunction.CountIf(rng.EntireColumn, rng.Value) = 1 Then _

dan staat het op 1 regel. Dat was iig de bedoeling toen ik de code schreef, herinner ik me nu.

Wigi

 

[jpvs]

Wigi,

Aangepast aan de macro en dit werkt ook natuurlijk.

Private Sub Worksheet_Change(ByVal Target As Range)
    'met dank aan Wigi
    Dim rng As Range, rngInters As Range
    On Error Resume Next
    Set rngInters = Application.Intersect(Target, Range("C1:E1").EntireColumn)
    For Each rng In rngInters
        If WorksheetFunction.CountIf(rng.EntireColumn, rng.Value) = 1 Then _
            Sheets("Blad1").Cells(Rows.Count, rng.Column + 7).End(xlUp).Offset(1).Value = Target.Value
        ' End If
    Next
End Sub

Eigenlijk werk je toch met een If en moet je niet afsluiten met End IF ?
Hoe kan dit ?



Pierre

 

[Wigi]

Alles staat op 1 regel door de _ karakter.

Je mag zelfs nog verder gaan:

If a > 0 Then Range("C1") = 3 Else Range("D2") = 9

bij wijze van voorbeeld. Heb je meer dan 1 regel, dan MOET de End If er staan.

Wigi

 

[jpvs]

Bedankt Wigi voor de uitleg.

Pierre

 

[Wigi]

Bedankt Wigi voor de uitleg.

Pierre

You're welcome, Pierre.