Voorwaardelijke opmaak macro

[Emiel1975]

Bijgelsoten rapport draai ik elke dag uit. In kolom P is een selectie van klantnummers in kolom M met bepaalde voorwaarde (niet belangrijk)

Als ik de selectie (nu zichtbaar in kolom P) invoer wil ik dat het volgende gebeurt.

1. Kijk in kolom M of de waarde in P2 gelijk is
2. En doe dit voor alle waardes van P2 t/m oneindig
3. Als deze overeenkomen, Markeer de regel van A t/m N geel

Note: dit overzicht is elke dag van een ander formaat.

Heeft iemand een idee hoe ik dit het makkelijkste bouw.
Heb wel een idee hoe ik de twee kolommen kan vergelijken maar ik loop tegen het voorwaardelijke opmaak stukje.

Alvast hartelijk dank

 

[Emiel1975]

Ik heb ondertussen ondervonden dat onderstaande macro wel goed werkt.
Alleen maakt het niet de gehele regels geel.

Sub Gele_Markering()
'
' Gele_markering Macro
'

'
Columns("M").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
End Sub

 

[Emiel1975]

Smily moet P zijn

 

[HSV]

Gewone opmaak i.p.v. voorwaardelijke opmaak.
Test het maar eens.

Sub hsv()
Dim sn, sq, c As Range, i As Long, ii As Long, y As Long
ActiveSheet.UsedRange.Interior.Color = xlNone
sn = Columns(13).CurrentRegion.Columns(1)
sq = Columns(16).CurrentRegion.Columns(1)
For i = 2 To UBound(sn)
 For ii = 1 To UBound(sq)
   If sn(i, 1) = sq(ii, 1) Then
       y = y + 1
         If y = 1 Then
            Set c = Cells(i, 1).Resize(, 14)
          Else
            Set c = Union(c, Cells(i, 1).Resize(, 14))
         End If
       End If
    Next ii
  Next i
If y > 0 Then c.Interior.Color = vbYellow
End Sub

 

[Emiel1975]

Beste Harry, ik kan je wel zoenen hahahahahahaa
Werkt perfect helemaal blij mee.

Ik probeer de macro te begrijpen.
Lukt het jou om kort even toe te lichten wat het doet, mag kort en bondig?
Wil dit soort dingen toch zelf in zijn geheel kunnen maken.


Hartelijk dank voor je hulp

 

[HSV]

Hallo Emiel,

Zet onderstaande code maar eens in de module.
Het is beter zichtbaar in het groen dan hier op het forum.

Sub hsv()
Dim sn, sq, c As Range, i As Long, ii As Long, y As Long  ' declareren van variabelen
ActiveSheet.UsedRange.Interior.Color = xlNone             ' alle kleuren verwijderen die in het blad staan. 
sn = Columns(13).CurrentRegion.Columns(1)                ' 1 dimensionale array aanmaken van kolom M
sq = Columns(16).CurrentRegion.Columns(1)                ' 1 dimensionale array aanmaken van kolom P
For i = 2 To UBound(sn)                                            ' start de lus en begin bij 2 to einde van array sn
 For ii = 1 To UBound(sq)                                           ' start de lus en begin bij 2 to einde van array sq
   If sn(i, 1) = sq(ii, 1) Then                                       ' als de waarde van sn(i,1) gelijk is aan sn(ii,1) dan verder naar regel eronder anders naar 'end if'.
       y = y + 1                                                         ' gewoon een teller die y steeds ophoogt als de code hier langs komt.
         If y = 1 Then                                                  ' als y = 1 dan volgende regel anders naar 'end if'.
            Set c = Cells(i, 1).Resize(, 14)                        ' indien y is 1 dan de cellen vastleggen in c (cells(i,1).resize(,14) is begin vanaf A en 14 naar rechts = A-N)

          Else                                                              ' anders
            Set c = Union(c, Cells(i, 1).Resize(, 14))          ' als y > 1 dan een vereniging maken van alle bereiken.
         End If                                      
       End If
    Next ii                                                                ' volgende deel van kolom P
  Next i                                                                   ' volgende  deel van kolom M
If y > 0 Then c.Interior.Color = vbYellow                      ' als y groter dan 0 maak alle cellen in de vereniging van c geel
End Sub

 

[Emiel1975]

Bedankt Harry voor je tijd en moeite.
Hier heb ik zeker wat aan.