Rot gefüllte Zellen sollen bei Änderung Makro starten.

[zwoologe]

Hallo liebe User,

ich brauche einen VBA code der folgendermaßen wirken soll:

In der Spalte H sollen alle Zellen, die sich in den Bereichen H4:H102, H109:H207 und H215:313 befinden UND ROT ausgefüllt sind, auf Änderungen überwacht werden um dann jeweils bei JEDER änderung ein Makro zu starten.

Das Ganze soll dann so gelebt werden:

Ich SELBST fülle pro Bereich 2- 4 Zellen, sind jeden Tag andere, durch Doppelklick rot (farbindex 3) aus und diese sind dann aufgrund ihrer roten Füllung in der überwachung.

Bisher hab ich die Zellpositionen immer händisch in den entsprechenden Worksheet eingetragen.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not [xlEIN] Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

'-- wenn flg true ist, Vorgang abrechen
    If flg Then flg = False: Exit Sub
'-- Spalte [spScanner] auswerten
    If Target.Column = [spScanner] Then Call GefundenenWert_Select(Target.Value)
'-- Spalte [spAnzahl] auswerten
    If Target.Column = [spAnzahl] Then Call GeheInZelle(Target.Row, [spScanner])
    
 '############################## Prüfalarm  #########################
    If Intersect(Target, Range("H7,H99,H112,H204,H218,H310")) Is Nothing Then Exit Sub
    Call MakroXYZ
  '#################################################################





End Sub

Am besten würde es mir gefallen wenn der VBA code nur einfach die Werte bei Range, analog der roten Zellen, im vorhandenden Sub Change ändert.

Wenn mir da jemand etwas liefern könnte, wäre ich sehr dankbar.

Grüße
zwoo

[Fennek]

Hallo,

warum nicht einfach eine weitere Prüfung auf

Code:

if Target.interior.color <> vbred then exit sub

mfg

[zwoologe]

Danke für die schnelle Antwort.

Code:

If Intersect(Target, Range("H4:H102,H109:H207,H215:313")) Is Nothing Then Exit Sub
   Call MakroXYZ

if Target.interior.color <> vbred then exit sub

End Sub

Meinst Du so? Ich teste das mal eben.

[zwoologe]

Es war so einfach, dass ich es nicht gleich hinbekommen habe. 


Danke Fennek, dass ist exakt das was ich wollte! Mein Tag ist gerettet. :78:




LG
zwoo

[zwoologe]

Hallo,

eine kleine Sache wäre da noch.

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
     With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
     End With
  End Sub

Wie bekomme ich es hier hin, dass es nur in den Spalten H bis M zu der gewünschten einfärbung führt und nicht auf dem gesamten Blatt?

LG
zwoo

[Fennek]

Hallo,

"Selction" ist mir zu unkontrolliert. Versuche es mal so (ungeprüft)

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
if  intersect(Target, columns("H:M")) is nothing then exit sub  
With Target.Interior
       .ColorIndex = 3
       .Pattern = xlSolid
    End With
 End Sub

mfg

[zwoologe]

Hallo Fennek,

auch diese Lösung funktioniert tadellos!

Vielen lieben Dank.


LG
zwoo