VBA code om een Excel cel automatisch te laten vullen

Status
Niet open voor verdere reacties.
Ik zou gebruik maken van codes/afkortingen ipv een compleet beschrijvende tekst in kolom K. Daarnaast natuurlijk ook gegevensvalidatie. Misschien is het ook even goed om naar de opzet van het bestand te kijken. Kolom 9 krijgt al een waarde als je iets wijzigt in kolom 11. Maar goed.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count <> 1 Then Exit Sub
  Application.EnableEvents = False
    With Target
      Select Case .Column
        Case 9
          .Offset(, -1) = "Ik doe maar wat"
        Case 11
          .Offset(, 1) = CDate(Now)
          .Offset(, 4).Resize(, 2) = "v"
          .Offset(, 8).Resize(, 2) = Array("v", Format(Date, "ww"))
          .Offset(, 11) = .Offset(, 11) + 1
          If InStr("BetaaltermijnGeen opdrachtGeen voorraadConcurrentOfferte klopte nietTe duurTe oudAlternatief niet okniet opgevolgdgeen opdrachtgeen voorraadconcurrentofferte klopte niet   te duurte oudalternatief niet okniet opgevolgd", .Value) Then
            .Offset(, -3).Resize(, 2) = Split("Ja Vervallen")
           Else
            .Offset(, 2) = "Nee"
          End If
      End Select
    End With
    Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Ik kom er weer even op terug.

Waar ik nog mee zit: ik krijg in kolom H (of 8) geen resultaat als ik in kolom I (9) tekst plaats. Wat ik graag wil, in kolom H de tekst "ja" als in kolom I wordt geschreven; "kansen", "in behandeling", "vervallen" of "order" .
En bij "vervallen" zou dan in kolom M (13) "nee" moeten komen.
Bij "kansen", "in behandeling" of "order" hoeft dat niet.

In de bijlage het bestand zoals ik die nu heb. Je kan aan de code die ik er zelf bij heb gezet wat ik bedoel wat er zou moeten gebeuren. Zoals je in de code kan zien weet ik niet hoe ik de verschillende opdrachten met elkaar koppel, of in de zelfde code kan plaatsen. Het kan vast veel simpeler, ik ben benieuwd. Er is vast veel over te zeggen, ik hoor heel graag jullie inhoudelijke adviezen of verbeteringen.

Ik hoop maar weer dat er met me meegedacht wordt, ik kijk reikhalzend uit naar de oplossingen.

Sowieso een fijn weekend alvast voor wie er aan toe is, groeten Hans

Bekijk bijlage forum-voorbeeld.xlsm
 
Probeer deze eens
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  With Target 'offertes
    Select Case .Column
      Case 9    'kolom 9
        .Offset(, -1) = "Ja"                                                'kolom H
        .Offset(, 3) = CDate(Now)                                           'kolom L
        .Offset(, 6).Resize(, 2) = "v"                                      'kolom O en P
        .Offset(, 10).Resize(, 2) = Array("v", Format(Date, "ww"))          'kolom S en T
        .Offset(, 13) = .Offset(, 13) + 1                                   'tellertje
        If .Value = "Vervallen" Then .Offset(, 4) = "Nee"  'kolom M
      
      Case 11   'kolom 11
        .Offset(, 1) = CDate(Now)                                           'kolom L
        .Offset(, 4).Resize(, 2) = "v"                                      'kolom O en P
        .Offset(, 8).Resize(, 2) = Array("v", Format(Date, "ww"))           'kolom S en T
        .Offset(, 11) = .Offset(, 11) + 1                                   'tellertje
        If InStr("BetaaltermijnGeen opdrachtGeen voorraadConcurrentOfferte klopte nietTe duurTe oudAlternatief niet okniet opgevolgdgeen opdrachtgeen voorraadconcurrentofferte klopte niet   te duurte oudalternatief niet okniet opgevolgd", .Value) Then
           .Offset(, -3) = "Ja"                                             'kolom H
           .Offset(, -2) = "Vervallen"                                      'kolom I
        ElseIf InStr("Afspraak op dit moment niet nodig of cp belt zelf welCp gaat stoppen, is gestopt, bouwt af, met pensioenHeeft geen behoefte aan contact/relatie met WascoLeverstop / Atradius / contantklantOndanks herhaald bellen/mail is contact niet geluktOp advies van VT niet bellen / vt heeft al contactO.b.v. segmentatie weinig potentie, bezoek van vt niet nodigRayon wijzigen???Uitgeschreven bij KvKVt kan bellen als hij in de buurt isZelf leverancier / groothandel / tussenhandel / internetshop", .Value) Then
           .Offset(, 2) = "Nee"                                             'kolom M
        End If
      
      Case Else
        Exit Sub
    End Select
  End With
Application.EnableEvents = True
End Sub
 
Hoi Jack

En weer een stap verder, geweldig. Klein (althans dat hoop ik) probleempje: als het bestand tussendoor wordt opgeslagen of ik moet teksten uit cellen verwijderen, gebeurt er daarna niets meer van wat allemaal in de code staat. Je zou bijna denken dat een bepaalde code maar eenmalig uitgevoerd kan worden.
Enig idee waar dat door wordt veroorzaakt?

Alvast bedankt maar weer!
 
Ik zag laatst in je code dat enableevents op true stond in het begin van je code.

Deze hoort in het begin van je code op false te staan en op het eind weer op true.
 
Ik denk dat die wel goed staan?

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
  With Target 'offertes
    Select Case .Column
      Case 9    'kolom 9
        .Offset(, -1) = "Ja"                                                'kolom H
        .Offset(, 3) = CDate(Now)                                           'kolom L
        .Offset(, 6).Resize(, 2) = "v"                                      'kolom O en P
        .Offset(, 10).Resize(, 2) = Array("v", Format(Date, "ww"))          'kolom S en T
        .Offset(, 13) = .Offset(, 13) + 1                                   'tellertje
        If .Value = "Vervallen" Then .Offset(, 4) = "Nee"  'kolom M
      
      Case 11   'kolom 11
        .Offset(, 1) = CDate(Now)                                           'kolom L
        .Offset(, 4).Resize(, 2) = "v"                                      'kolom O en P
        .Offset(, 8).Resize(, 2) = Array("v", Format(Date, "ww"))           'kolom S en T
        .Offset(, 11) = .Offset(, 11) + 1                                   'tellertje
        If InStr("BetaaltermijnGeen opdrachtGeen voorraadConcurrentOfferte klopte nietTe duurTe oudAlternatief niet okniet opgevolgdgeen opdrachtgeen voorraadconcurrentofferte klopte niet   te duurte oudalternatief niet okniet opgevolgd", .Value) Then
           .Offset(, -3) = "Ja"                                             'kolom H
           .Offset(, -2) = "Vervallen"                                      'kolom I
        ElseIf InStr("Afspraak op dit moment niet nodig of cp belt zelf welCp gaat stoppen, is gestopt, bouwt af, met pensioenHeeft geen behoefte aan contact/relatie met WascoLeverstop / Atradius / contantklantOndanks herhaald bellen/mail is contact niet geluktOp advies van VT niet bellen / vt heeft al contactO.b.v. segmentatie weinig potentie, bezoek van vt niet nodigRayon wijzigen???Uitgeschreven bij KvKVt kan bellen als hij in de buurt isZelf leverancier / groothandel / tussenhandel / internetshop", .Value) Then
           .Offset(, 2) = "Nee"                                             'kolom M
        End If
      
      Case Else
        Exit Sub
    End Select
  End With
Application.EnableEvents = True
End Sub
 
Probeer dit eens uit
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count <> 1 Then Exit Sub
  Application.EnableEvents = False
of
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.value = "" Then Exit Sub
  Application.EnableEvents = False
 
De eerste code gaf geen oplossing, de tweede werkt wel. Maar als ik een bereik van meerder cellen op meerder rijen selecteer om met de del toets de inhoud te verwijderen krijg ik deze foutmelding.

Excel-voorbeeld foutmelding.PNG

Ook krijg ik een foutmelding als ik een hele rij wil verwijderen, of een rij invoeg.

Excel-voorbeeld foutmelding2.PNG
 
Als je bedoelt of ik beide stukjes code heb ingepast die je me eerder stuurde: alleen de laatste.
Als je bedoelt of beide foutmeldingen komen met de aanduiding waar in de code een fout zit, ja beide meldingen verschijnen.
 
Op deze manier bedoel ik.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
 
Supersnelle Jack, dank je wel. Ik ga morgen op mijn werk kijken of het lukt.
 
Bericht in #21 gemist?

@Jack Nouws, waarom die dubbele regels?
 
@VenA, ik heb bericht 21 gelezen en de code gebruikt.

@ Jack, VenA, wat er verkeerd gaat weet ik niet maar telkens stopt de code met het uitvoeren van zijn werkzaamheden, sowieso altijd na het verwijderen van een rij of het kopiëren en invoegen van rijen. Ook als ik met de del toets inhoud uit cellen verwijder. Na automatisch opslaan werkt de code ook niet meer.

Jack, VenA, is het een idee dat ik jullie het volledige bestand mail zodat jullie kunnen kijken wat er mis gaat? Er staan nogal wat koppelingen, macro's en formules in namelijk, misschien zit daar een boosdoener?
Ik kan het volledige bestand niet hier publiceren, er staat teveel gevoelige informatie in.
 
Laatst bewerkt:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
  With Target 'offertes
    Select Case .Column
      Case 9    'kolom 9
           .Offset(, -1) = "Ja"                                              'kolom H
        If .Value = "Vervallen" Then .Offset(, 4) = "Nee"  'kolom M
      Case 11   'kolom 11
        If InStr("BetaaltermijnGeen opdrachtGeen voorraadConcurrentOfferte klopte nietTe duurTe oudAlternatief niet okniet opgevolgdgeen opdrachtgeen voorraadconcurrentofferte klopte niet   te duurte oudalternatief niet okniet opgevolgd", .Value) Then
           .Offset(, -3) = "Ja"                                             'kolom H
           .Offset(, -2) = "Vervallen"                                      'kolom I
        ElseIf InStr("Afspraak op dit moment niet nodig of cp belt zelf welCp gaat stoppen, is gestopt, bouwt af, met pensioenHeeft geen behoefte aan contact/relatie met WascoLeverstop / Atradius / contantklantOndanks herhaald bellen/mail is contact niet geluktOp advies van VT niet bellen / vt heeft al contactO.b.v. segmentatie weinig potentie, bezoek van vt niet nodigRayon wijzigen???Uitgeschreven bij KvKVt kan bellen als hij in de buurt isZelf leverancier / groothandel / tussenhandel / internetshop", .Value) Then
           .Offset(, 2) = "Nee"                                             'kolom M
        End If
    End Select
       Cells(.Row, 12) = CDate(Now)                                          'kolom L
       Cells(.Row, 15).Resize(, 2) = "v"                                     'kolom O en P
       Cells(.Row, 19).Resize(, 2) = Array("v", Format(Date, "ww"))          'kolom S en T
       Cells(.Row, 22) = Cells(.Row, 22) + 1                                 'tellertje
  End With
Application.EnableEvents = True
End Sub
In jou voorbeeld bestand (Post 22) loopt deze code naar mijn weten vlekkeloos. Ik ondervind geen problemen met verwijderen van gegevens of rijen in je vb bestand. Het kan dus zoals je zegt, dat diverse formules en/of koppelingen invloed hebben op je originele bestand. Helaas kan ik je niet verder helpen dan dit forum. De kennis van vba ligt bij mensen zoals snb, VenA, HSV, Dotchie Jack etc. toch wel wat hoger dan bij mij.
grt. Jack
 
@VenA, ik heb bericht 21 gelezen en de code gebruikt.
Klik om te vergroten...
Zowel de code als de aangereikte suggesties zie ik nergens terug.

Ik zie ook niet waar het fout gaat met de laatste, wat ingekorte:thumb:, code van @Jack Nouws. Gevoelige informatie kan je vervangen door wat anders. Je kan een On Error Goto inbouwen waarmee je de Events weer op TRUE zet. De dubbele kolomkoppen en lange teksten maakt het er in mijn optiek ook allemaal niet duidelijkere op.

Begin met een simpel bestand zodat je kan begrijpen hoe dit soort code in elkaar steekt.
 
Erg druk geweest de afgelopen week dus even laten rusten, nu heb ik het weer opgepakt. Alle formules en koppelingen verwijderd en het werkt nu zonder storingen of foutmeldingen.

VenA, zou jij eens naar het bijgevoegde bestand willen kijken? Het is een andere code (van Jack) dan die jij voorgesteld, maar voor mij is deze overzichtelijk en makkelijker te begrijpen.
Het werkt alleen niet helemaal.
Het eerste deel, mutaties in kolom 11, doet wat er staat. Het tweede deel, mutaties in kolom 9 en het derde deel, mutaties in kolom 10 doet echter niets. Ik hoop dat er een kommaatje bij moet of zoiets eenvoudigs :d

Ik hoop dat de code bruikbaar is en straks echt doet wat ik hoop! Ik kijk uit naar een reactie.

Bekijk bijlage forum-voorbeeld (1).xlsm
 
Wat denk je dat deze regel doet?

Code: 
If Target.Column <> 11 Then Exit Sub
 
Ja, dat áls er iets gebeurt in kolom 11 dan gebeurt dit-of-dat in een andere kolom en sluit die de verdere activiteiten af? Als dat klopt dan zou daar iets in moeten veranderen, ik weet alleen niet hoe.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan