Celkleur veranderen bij gewijzigde inhoud

[Fenadna]

Ik heb een bestand gemaakt waarin ik graag de celkleur wil veranderen, zodra iemand een wijziging invoert. Zodra de oude waarde of formule weer teruggezet wordt, moet deze celkleur weer verwijderd worden. Is dit mogelijk?

 

[VenA]

Ja dat kan met een beetje code en voorwaardelijke opmaak. De code wordt dan zoiets:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address(0, 0) = "A2" Then
    With Application
      .EnableEvents = False
      nw = Target.Formula
      .Undo
      old = Target.Formula
      Target = nw
      If Target.Offset(, 1) = "" Then Target.Offset(, 1) = old
      .EnableEvents = True
    End With
  End If
End Sub

 

[Fenadna]

Ik heb deze code gekopieerd naar de visual basic, maar de cellen in het bewuste tabblad krijgen geen andere kleur als ik een ander getal intyp.

 

[VenA]

De code zal je natuurlijk wel moeten aanpassen in het niet geplaatste bestand. De vraag is of het kan verder ontbreekt alle relevante informatie.
Lees eerst dit maar even: https://www.helpmij.nl/forum/announcement.php?f=5

 

[Fenadna]

Kun je aangeven welke gegevens ik moet wijzigen. Ik kan geen VBA.

 

[Senso]

Plaats een voorbeeldbestand zonder persoonsgegevens. Uploaden via > Ga geavanceerd en de paperclip etc.

 

[Fenadna]

Het is een heel groot bestand, dus ik heb maar 1 tabblad gevuld, maar er zijn ongeveer 15 tabbladen.

 

[VenA]

Lees het linkje in #4 eens grondig door. Stel je zelf dan de vraag wat moet een helper met een halve vraag en een onwerkbaar bestand?

 

[Fenadna]

In het linkje #4 zie ik deze tekst staan, waar ik netjes aan heb proberen te houden:
"Beperk de inhoud van het bestand tot de vraag die u heeft."

Het is niet zinvol om een groter bestand te sturen, want alle tabbladen zijn hetzelfde, maar dan voor een ander team.

De teams moeten deze begroting zelf invullen, maar ik wil graag weten waar ze wijzigingen hebben aangebracht. Ik dacht dit te kunnen doen dmv een kleurtje als ze ergens een bedrag wijzigen of invullen. Ik hoop dat het zo duidelijker is.

 

[VenA]

Zet in het bestand een beperkt aantal, gevarieerde voorbeeldgegevens.
Verwijder alle privacy-gevoelige en bedrijfsgevoelige gegevens uit uw voorbeeldbestand.
Verwijder alle verbindingen (Links/Connecties) naar bestanden die voor helpers niet beschikbaar zijn.
Geef informatie

Beschrijf in uw vraag:
- de uitgangssituatie
de gewenste eindsituatie en waarvoor u die nodig hebt
wat u al geprobeerd hebt

Ik zie het allemaal niet terug.

 

[Senso]

Onderstaande nog wel gevonden.

Private Sub Worksheet_Change(ByVal Target As Range)
Target.Interior.ColorIndex = 6
End Sub

Dat is eenmalig. Oude waarde weer terugzetten? Lees op internet dat het niet kan. Dan moet je voor iedere cel een "geheugen" hebben.

 

[VenA]

#2 gemist en de rest gemist?

 

[Senso]

Ik geef aan wat ik daar over op internet lees. Aangezien jij veel 'kritiek' hebt op TS, kan ik nou ook niet zeggen dat jouw tekst allemaal even overtuigend is.

Ja dat kan met een beetje code en voorwaardelijke opmaak. De code wordt dan zoiets:

Een 'beetje' en 'zoiets'? Het is mijn gewoonte dat als ik iets aanbied om het dan te testen, een eigen bestand te plaatsen en wat uitleg te geven. Inderdaad dat mis ik. Ik heb jouw code wel geprobeerd, maar mijn deel werkt en jouw deel niet.

 

[HSV]

Dat is eenmalig. Oude waarde weer terugzetten? Lees op internet dat het niet kan. Dan moet je voor iedere cel een "geheugen" hebben.

Inderdaad eenmalig, na elke verandering is het weg of je moet het bijhouden in een ander blad of de gegevens niet opslaan.
Voor de rest lees je teveel van verkeerde personen.

 

[VenA]

@Senso,
Dat wat jij gevonden hebt heeft totaal niets met de half gestelde vraag te maken. Jouw gevonden code kleurt elke cel bij een wijziging. Daarnaast heb ik geen kritiek op de TS maar probeer de vraag duidelijk te krijgen.

Wijzig jouw naam in A2 in iets anders en zie het effect. Zet in A2 jouw eigen naam en zie het effect.

 

[cow18]

Het is een heel groot bestand, dus ik heb maar 1 tabblad gevuld, maar er zijn ongeveer 15 tabbladen.

15 werkbladen, 500 rijen * 30 kolommen, wijzigingen bijhouden met een voorwaardelijke opmaak, dat wordt een onwerkbaar trage werkmap.

Ik zou ergens in je systeem een origineel bijhouden en van tijd tot tijd eens vergelijken met het actuele.
Zo zou je heel snel de wijzigingen kunnen er bij zetten.

Sub vergelijken()
   t = Timer

   Set sh1 = ThisWorkbook.Sheets("FB Vellerveste")              'huidig werkblad
   Set sh2 = ThisWorkbook.Sheets("FB Vellerveste (2)")          'zelfde werkblad, maar backup, in deze werkmap of in een andere !!!

   Set ur1 = sh1.UsedRange                                      'bepalen bereik
   Set ur2 = sh2.UsedRange
   rijen = Application.Max(ur1.Row + ur1.Rows.Count - 1, ur2.Row + ur2.Rows.Count - 1)   'max aantal rijen
   kolommen = Application.Max(ur1.Column + ur1.Columns.Count - 1, ur2.Column + ur2.Columns.Count - 1)   'max aantal kolommen
   arr1 = sh1.Range("a1").Resize(rijen, kolommen).Value2        'huidige gegevens -> array
   arr2 = sh2.Range("a1").Resize(rijen, kolommen).Value2        'backup-gegevens -> array

   Set dict = CreateObject("scripting.dictionary")              'dictionary
   For r = 1 To rijen                                           'alle rijen aflopen
      For k = 1 To kolommen                                     'alle kolommen aflopen
         If arr1(r, k) <> arr2(r, k) Then dict.Add dict.Count, Array(Cells(r, k).Address, arr1(r, k), arr2(r, k))   'indien wijziging, onthouden
         DoEvents
      Next
   Next
   MsgBox "werkblad : " & sh1.Name & vbLf & "rijen * kolommen ; " & rijen & " * " & kolommen & vbLf & "wijzigingen : " & dict.Count & vbLf & "tijd : " & Format(Timer - t, "0\s")

   With Sheets("gewijzigd")
      .UsedRange.ClearContents
      If dict.Count Then .Range("A1").Resize(dict.Count, 3).Value = Application.Index(dict.items, 0, 0)   'wijzigingen wegschrijven naar werkblad
   End With
End Sub

Toevoeging :
je zou dan ook nog met een aan/uit knop, die voorwaardelijke opmaak tijdelijk kunnen activeren.
Desnoods zou je de originele waarde nog in de opmerking van die cel kunnen meegeven. Op die manier zou je dan gemakkelijk van opmerking naar opmerking kunnen springen.
Ik veronderstel dat dit dient om begrotingen met elkaar te vergelijken, zo zou je meerdere versies na elkaar kunnen vergelijken en telkens de wijziging meegeven.
Dit kan enkel maar goed werken, als je nooit geen rijen of kolommen gaat tussenvoegen.

PS. ik zie dat TS niet altijd netjes terugkoppelt bij vroeger gestelde vragen

 

[AD1957]

Als ik het blad beveilig zie je dat de meeste cellen zijn geblokkeerd.
Met de code van VenA zou het volgens mij moeten lukken.
Voor de range("O222:O417,Q222:Q417") heb ik het eens getest, lijkt goed te werken.
Wel even de kolommen vanaf kolom 31 deblokkeren.

Private Sub Worksheet_Change(ByVal Target As Range)
  
 If Not Intersect(Target, Range("O222:O417,Q222:Q417")) Is Nothing Then
    With Application
      .EnableEvents = False
      nw = Target
      .Undo
      old = Target
      Target = nw
      If Target.Offset(, 20) = "" Then Target.Offset(, 20) = old
      .EnableEvents = True
    End With
    
    ActiveSheet.Unprotect
    Target.Interior.Color = RGB(181, 176, 208)
    If Target <> Target.Offset(, 20) Then Target.Interior.Color = vbRed
    ActiveSheet.Protect
    
  End If

  
End Sub

 

[HSV]

@AD1957, Een code in een bladmodule heeft aanroep nodig van Activesheet.

 

[AD1957]

Hallo Harry,

De code staat nu alleen in Blad1 en voor zover ik kan zien werkt deze.
Waarom is de aanroep van Activesheet dan nodig. ( of mis ik iets, mijn kennis van VBA is nml. vele malen minder dan die van jou)

In een Change_event is dit natuurlijk verre van ideaal (als TS zelf eerst nog iets aanpast gaat het fout)

 

[HSV]

Mijn excuses.

Ik ben het woordje geen vergeten.
Activesheet is dus overbodig.