SNEL/LAK

[Ron001]

Beste Helpers

 

In week 7 staan rechtsboven 2 kaders (één voor vroege ploeg, één voor late ploeg).
Bij elke ploeg heb je iemand die sneldienst/lakstraat doet, dus mijn vraag;

Als je bv in range("A17:A35) de loonnummer verandert naar SNEL/LAK dat de naam die in range("B17:B35") staat gekopieerd wordt naar AA2 (Snel) en AA3 (LAK)
Max 1 SNEL/LAK per range en foutmelding bij 2de SNEL/LAK per range
Als je verandert naar andere persoon, loonnummer terug verschijnt.

Alvast hartelijk bedankt!

sneldienst.xlsm

[Ron001]

Ik heb voorlopig dit, maar werkt niet :-(

 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

For Each cl In ActiveWorkbook.Range("A17:A26")
    If cl.Value = "SNEL" Then
        cl.Value.Offset(, 1).Copy = Range(AA2)
    End If
    Next
End Sub

 

[Gast]

Quote

 

Private Sub Worksheet_Change(ByVal Target As Range)
For Each cl In Range("A17:A26")
If cl.Value = "SNEL" Then [AA2].Value = cl.Offset(, 1).Value
Next cl
End Sub

 

[Ron001]

Doet niets...:-(

[Ron001]

Werkt wel met: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
For Each cl In Range("A17:A26")
If cl.Value = "SNEL" Then [AA2].Value = cl.Offset(, 1).Value
Next cl

End Sub

Maar krijg nu foutmelding op :

[AA2].Value = cl.Offset(, 1).Value

Stack niet groot genoeg, excel valt dan uit...

[Ron001]

Nog wat aan het testen geweest...

Werkt wel met:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

Waar kan ik nu ook bv nog bijvoegen "snel", "SnEl","Lak","LAK"

En de foutmelding bij meerdere "SNEl's en LAK's in dezelfde range?

 

Alvast bedankt

27 maart 2018 aangepast door Ron001

[Ron001]

Bedankt!

 

Onderstaande code heb ik "proberen" te schrijven..

Ik heb deze nu opgesplitst in "SNEL" en "LAK", kan deze samengevoegd worden?

En de foutmelding bij meer als 1 "SNEL" en "LAK" in een range?

Dat dus ook de tweede "SNEL" en "LAK" niet kan gezet worden?

 

Alvast bedankt!

 

Sub ron()

For Each cl In ActiveSheet.Range([A17:A26], [A28:A35])
If UCase(cl.Value) = "SNEL" Then [AA2].Value = cl.Offset(, 1).Value
'If cl.Offset(, 1).Value > 1 Then MsgBox "[AA2].Value  is al aangeduid." 'WERKT NIET
Next cl
For Each cl In ActiveSheet.Range([A17:A26], [A28:A35])
If cl.Value = "LAK" Then [AA3].Value = cl.Offset(, 1).Value
Next cl

End Sub

 

[alpha]

@Ron,

Het nut van je macro ontgaat mij, want je doorloopt een heleboel cellen, maar alleen de laatste die aan de voorwaarde voldoet wordt in AA2 of AA3 ingevuld. Dat gezegd zijnde, als je de macro toch wil gebruiken kan dat op deze manier:

Sub ron2()
Dim cl As Variant
With ActiveSheet
Set myrange = Union(.Range("A17:A26"), .Range("A28:A35"))
.Range("AA2:AB3").ClearContents
For Each cl In myrange
Select Case UCase(cl.Value)
Case "SNEL"
Range("AA2").Value = cl.Offset(, 1)
Case "LAK"
Range("AA3").Value = cl.Offset(, 1)
End Select
Next cl
End With
End Sub

 

29 maart 2018 aangepast door alpha

[alpha]

Enkele dingen vergeten zie ik, daarom deze correctie:

Sub ron3()
Dim cl As Variant, myrange As Range
With ActiveSheet
Set myrange = Union(.Range("A17:A26"), .Range("A28:A35"))
.Range("AA2:AB3").ClearContents
For Each cl In myrange
Select Case UCase(cl.Value)
Case "SNEL"
.Range("AA2").Value = cl.Offset(, 1)
Case "LAK"
.Range("AA3").Value = cl.Offset(, 1)
End Select
Next cl
End With
End Sub

[Ron001]

Dit lijkt mij toch nuttig, moeten diegene die de file invullen enkel  "snel" of "lak" zetten...

 

Ik moet enkel die twee kleine ranges doorlopen ("A17:A26") en ("A28:A35")

 

Ik krijg foutmelding op 

.Range("AA2:AB3").ClearContents

Waarom staat dit er eigenlijk?

Met de rest van de code ben ik wel helemaal mee