alle cellen selecteren en de tussen liggende cellen selecteren en geel maken.

[mause01]

Dames & Heren, HELP: :shocked:

Ik wil graag in excel een macro maken waarmee ik alle cellen selecteer welke een waarde hebben.
Verder moeten de lege cells ook worden geselecteerd en een gele kleur krijgen.
het is geen vast range, de range wordt bepaald door de cellen welke waarde hebben van B7 tot AI5000.
ik wil graag geen selectie maken op de cellen, welke onder de laatste rij van cellen welke wel een waarde hebben.

ik krijg het niet voor elkaar.



Uitleg.
Dit betreft een voorbeeld waar de klant 5 rijen heeft ingevuld.
Rood moet niet worden geselecteerd naar beneden.
de lege cellen moeten geel worden.

Het kan zijn dat de volgende klant meer rijen benodigd heeft.

Wat reeds heb qua macros:

Selecteren:
Sub Macro_Select()
'
Dim rng As Range

Set rng = Range("B7:AI5000,B2:AI2")
rng.SpecialCells(xlCellTypeConstants).Select


End Sub

Geel maken:
Sub Macro_ExtID_check()
'
' Macro_ExtID_check Macro

Dim myRange As Range
Set myRange = Sheet1.Range("C7:C5000")
For Each myCell In myRange
If myCell.Value Then
myCell.Interior.ColorIndex = 0
Else
myCell.Interior.ColorIndex = 6
End If
Next
End Sub

 

[Cobbe]

Het voorbeeldbestand is zeer duidelijk!

 

[gast0660]

Voor wat ik ervan heb begrepen, zoiets?

 

[mause01]

Voor wat ik ervan heb begrepen, zoiets?

Beste gast0660,

Helemaal super,:thumb:
Enkel ik wil graag ook de range B2:AI selecteren en een bericht krijgen wanneer er lege velden(gele velden) zijn, een message box.

Hoe doe ik dat op deze code?

Alvast bedankt helemaal top.


Sub Macro_Select3()
Application.ScreenUpdating = False
lRow = Range("B" & Rows.Count).End(xlUp).Row
Set MR = Range("B7:AI" & lRow)
For Each cell In MR
If cell.Value <> "" Then MR.SpecialCells(xlCellTypeConstants).Select
If cell.Value <> "" Then cell.Interior.ColorIndex = 0
If cell.Value = "" Then cell.Interior.ColorIndex = 6
Next
Application.ScreenUpdating = True
End Sub

 

[gast0660]

Euh??
Bedoel je nu
B2:AI2
Als daar iets leeg is bericht en dan de rest van de code
of eerst B2:AI chechen op lege velden indien iets leeg bericht en dan de rest van de code uitvoeren vanaf B7.

 

[mause01]

Euh??
Bedoel je nu
B2:AI2
Als daar iets leeg is bericht en dan de rest van de code
of eerst B2:AI chechen op lege velden indien iets leeg bericht en dan de rest van de code uitvoeren vanaf B7.

De selectie met de code is goed enkel wil ik ook B2 tot AI2 selecteren.
ik zal de excel uploaden om te zien wat ik bedoel.
Marco_Select3
Nu krijg je netje gele velden wanneer Blank, maar rechts van de laatste cel worden de rijen ook geel kan dat ook daar stoppen zoals laatste cel onderaan.
Wanneer er gele cellen zijn dan een bericht dat er nog iets ingevuld moeten worden.

Wanneer ik RunAllMacros run dan wordt er geselecteerd en naar CSV gezet.
https://we.tl/uqrSReLPv1

 

[gast0660]

ik zal de excel uploaden

Ok, ik wacht eventjes op het vb bestandje.

 

[mause01]

Ok, ik wacht eventjes op het vb bestandje.

Ik heb de link geplaatst !

 

[Cobbe]

Test deze eens:

Sub Macro_Select3()
Application.ScreenUpdating = False
Range("B2:AI2").Interior.ColorIndex = 15
Range("B7:AI50").Interior.ColorIndex = xlNone
Lrow = Range("B" & Rows.Count).End(xlUp).Row
Lcol = Range("B" & Lrow).End(xlToRight).Column
Set MR = Range(Cells(7, "B"), Cells(Lrow, Lcol))
For Each cell In MR
    If cell.Value <> "" Then MR.SpecialCells(xlCellTypeConstants).Select
    If cell.Value <> "" Then cell.Interior.ColorIndex = 0
    If cell.Value = "" Then cell.Interior.ColorIndex = 6: Cells(2, cell.Column).Interior.ColorIndex = 3
Next
Application.ScreenUpdating = True
End Sub

 

[snb]

mause01

Plaats voorbeeldbestanden in dit forum, dan blijven ze behouden voor latere bezoekers van dit forum.
Dit forum is een veilige omgeving.

 

[mause01]

Test deze eens:

Sub Macro_Select3()
Application.ScreenUpdating = False
Range("B2:AI2").Interior.ColorIndex = 15
Range("B7:AI50").Interior.ColorIndex = xlNone
Lrow = Range("B" & Rows.Count).End(xlUp).Row
Lcol = Range("B" & Lrow).End(xlToRight).Column
Set MR = Range(Cells(7, "B"), Cells(Lrow, Lcol))
For Each cell In MR
    If cell.Value <> "" Then MR.SpecialCells(xlCellTypeConstants).Select
    If cell.Value <> "" Then cell.Interior.ColorIndex = 0
    If cell.Value = "" Then cell.Interior.ColorIndex = 6: Cells(2, cell.Column).Interior.ColorIndex = 3
Next
Application.ScreenUpdating = True
End Sub

Beste Cobbe,

Ziet er goed uit, maar 2 puntjes.

Puntje 1:
De rij B2:AI wordt niet geselecteerd dit moet wel het geval zijn.

Puntje 2:
Rij B2:AI worden nu mooi rood als er geen waarde is in het kolom.
Maar dit komt samen met een macro om het weer terug te zetten.
kan er toegevoegd worden dat deze weer grijs worden.

Sub Macro_Clear()
'
' Macro_Clear

Range("B7:AI5000").ClearContents
Range("B7").Select
Range("B7:AI5000").Interior.ColorIndex = xlNone

End Sub

Erg dankbaar voor de hulp, Bedankt.:thumb:

 

[Cobbe]

Sub Macro_Select3()
  With Range("B2:AI2")
[COLOR="#FF0000"]'rij 2 selecteren[/COLOR]
     .Select
[COLOR="#FF0000"]'rij 2 grijs kleuren[/COLOR]
     .Interior.ColorIndex = 15
  End With
  Range("B7:AI" & Range("B" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
  Lrow = Range("B" & Rows.Count).End(xlUp).Row
  Lcol = Range("B" & Lrow).End(xlToRight).Column
  Set MR = Range(Cells(7, "B"), Cells(Lrow, Lcol))
    For Each cell In MR
        If cell.Value <> "" Then MR.SpecialCells(xlCellTypeConstants).Select
        If cell.Value <> "" Then cell.Interior.ColorIndex = 0
        If cell.Value = "" Then cell.Interior.ColorIndex = 6: Cells(2, cell.Column).Interior.ColorIndex = 3
    Next
End Sub

 

[mause01]

Sub Macro_Select3()
  With Range("B2:AI2")
[COLOR="#FF0000"]'rij 2 selecteren[/COLOR]
     .Select
[COLOR="#FF0000"]'rij 2 grijs kleuren[/COLOR]
     .Interior.ColorIndex = 15
  End With
  Range("B7:AI" & Range("B" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
  Lrow = Range("B" & Rows.Count).End(xlUp).Row
  Lcol = Range("B" & Lrow).End(xlToRight).Column
  Set MR = Range(Cells(7, "B"), Cells(Lrow, Lcol))
    For Each cell In MR
        If cell.Value <> "" Then MR.SpecialCells(xlCellTypeConstants).Select
        If cell.Value <> "" Then cell.Interior.ColorIndex = 0
        If cell.Value = "" Then cell.Interior.ColorIndex = 6: Cells(2, cell.Column).Interior.ColorIndex = 3
    Next
End Sub

Deze is helemaal perfect.
Bedankt.

De Clear Macro is ook al actief en dus prima.

.------------

Wanneer ik op de laatste rij een waarde weg haal, dan selecteert hij niet alles.
Met waarde:

Zonder waarde in bruin.


kan dit verholpen worden of gaat dat niet anders.

 

[snb]

Ik zou Excel het werk laten doen met:

Sub M_snb()
  Range("A2:AI2,A3:A30").Interior.ColorIndex = 15
  
  With Cells(2, 2).CurrentRegion.Offset(5, 1).Resize(, 34)
      .SpecialCells(2).Interior.ColorIndex = 0
      .SpecialCells(4).Interior.ColorIndex = 6
      .Offset(, -1).Resize(, 1).Interior.ColorIndex = 3
  End With
End Sub

NB. Het kleuren van een volledige kolom blaast de omvang van je bestand zinloos op.

 

[mause01]

Deze is helemaal perfect.
Bedankt.

Voorgaande vraag opgelost.

 

[snb]

Zet svp de VBA-code tussen code markeringen (code tags) zoals ook alle andere gebruikers in dit forum doen.

 

[mause01]

Zet svp de VBA-code tussen code markeringen (code tags) zoals ook alle andere gebruikers in dit forum doen.

Sorry, hierbij.

 

[snb]

Dat scheelt een slok op een borrel :thumb:

Had je mijn post in #14 gezien ?

 

[mause01]

Dat scheelt een slok op een borrel :thumb:

Hahahah,
Nou jullie hulp, Dat scheelt.
Super blij mee.

 

[snb]

Kun je vervolgens proberen de Qoute knop niet te gebruiken voor een antwoord ?

De knop 'reageer op bericht' is effektief genoeg.