Macro voor automatisch rijen verbergen en weer zichtbaar maken

[basvankrimpen]

Hi,

Ik heb een heel groot bestand voor mijn werk waar wij elke week bepaalde zaken moeten evalueren.
De dump komt voort uit een heel jaar en alles wat in het verleden is wil ik automatisch verbergen. Nou heb ik zelf een macro gemaakt, maar hoewel ik geen foutmelding krijg doet deze ook niet wat ik wil...
De macro voor het tonen werkt wel als ik zelf rijen verberg en dan op de knop druk.

Kan iemand mij helpen om de juiste macro voor elkaar te krijgen?

Veel dank. Voorbeeld bestand in de bijlage.

Bekijk bijlage Test.xlsm

 

[Gijsbert1]

Hallo Bas,

Probeer deze code eens:

Sub Verbergen()
Dim LastRow As Long
LastRow = Range("E" & Rows.Count).End(xlUp).Row
 For nRij = 1 To LastRow
     Rows(nRij & ":" & nRij).EntireRow.Hidden = ((Cells(nRij, "E").Value < Range("$C$3")) And (IsEmpty(Cells(nRij, "E").Value) = False))
  Next
End Sub

 

[basvankrimpen]

werkt! dank Gijsbert

 

[edmoor]

Wellicht dat dit wat sneller is?

Sub Verbergen()
    Dim LastRow As Long
    
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    End With

    Application.ScreenUpdating = False
    For i = 7 To LastRow
        Rows(i).EntireRow.Hidden = IIf(Cells(i, 5).Value <= Range("C3").Value, True, False)
    Next i
    Application.ScreenUpdating = True
End Sub

 

[basvankrimpen]

Zeker sneller inderdaad, super dank voor de hulp!

 

[basvankrimpen]

Toch nog een vraag als ik nu in de kolom er naast alleen review wil selecteren heft die de selectie daarvoor weer op.. Is dat ook mogelijk om te combineren?

 

[VenA]

Nog een variant voor het verbergen.

Sub VenA()
dim cl, u
For Each cl In Columns(5).SpecialCells(2, 1)
    If cl < [C3] Then
        If u = "" Then Set u = cl Else Set u = Union(u, cl)
    End If
Next cl
u.EntireRow.Hidden = True
End Sub

Jouw laatste vraag begrijp ik niet helemaal.

 

[Gijsbert1]

Misschien bedoelt hij zoiets met zijn laatste vraag:

Sub Verbergen()
Dim LastRow As Long
Dim Message As Integer

LastRow = Range("E" & Rows.Count).End(xlUp).Row
Message = MsgBox("enkel review tonen?", vbYesNo, "maak keuze")

Application.ScreenUpdating = False

If Message = vbNo Then
    For nRij = 7 To LastRow
    Rows(nRij & ":" & nRij).EntireRow.Hidden = ((Cells(nRij, "E").Value < Range("$C$3")))
    Next
Else
    For nRij = 7 To LastRow
    Rows(nRij & ":" & nRij).EntireRow.Hidden = ((Cells(nRij, "F").Value <> "Review")) Or ((Cells(nRij, "E").Value < Range("$C$3")))
    Next

Application.ScreenUpdating = True

End If

End Sub

De code kan ongetwijfeld worden ingekort! :d

 

[VenA]

Waarom eigenlijk niet met het autofilter?

Sub VenA()
With [e6].CurrentRegion
    .AutoFilter 1, ">=" & [c3]
    If MsgBox("enkel review tonen?", vbYesNo, "maak keuze") = vbYes Then .AutoFilter 2, "Review"
End With
End Sub

 

[HSV]

@VenA, als elke cl > [c3] zal 'u' geen 'set u' worden, en zal dit een foutmelding creëren.

u.EntireRow.Hidden = True

Als de eerste waarde die aan de voorwaarde voldoet zal het hier op stuk lopen.

if u ="" then

For Each cl In Columns(5).SpecialCells(2,1)
    If cl < [C3] Then
        If isempty(u) Then 
            Set u = cl
         Else 
           Set u = Union(u, cl)
      end if
    End If
Next cl
If not isempty(u) Then u.EntireRow.Hidden = True

aanvulling:
Het kan uiteraard eenvoudiger als je 'u' declareert als 'Range' i.p.v. 'Variant'.

if u is nothing then
if not u is nothing then u.entirerrow.hidden = true

 

[VenA]

@HSV,
Bedankt voor de aanvulling. Dit had ik zelf ook gezien toen ik nog even met de code aan het spelen was om ook de tweede vraag te beantwoorden. Hoewel het niet geheel overeen komt met de OP leek mij het autofilter een goed alternatief en heb ik deze geplaatst.
Het verbergen van rijen met meerdere/verschillende voorwaarden staat al in de code Gijsbert1 dus daar zou de TS zelf wel verder mee moet kunnen komen.

En anders is deze een beetje sneller.

Sub VenA()
Dim cl, u As Range
If MsgBox("enkel review tonen?", vbYesNo, "maak keuze") = vbYes Then
    For Each cl In Columns(5).SpecialCells(2, 1)
        If cl < [c3] Or LCase(cl.Offset(, 1)) <> "review" Then If u Is Nothing Then Set u = cl Else Set u = Union(u, cl)
     Next cl
  Else
    For Each cl In Columns(5).SpecialCells(2, 1)
        If cl < [c3] Then If u Is Nothing Then Set u = cl Else Set u = Union(u, cl)
    Next cl
End If
If Not u Is Nothing Then u.EntireRow.Hidden = True
End Sub

 

[basvankrimpen]

dank allen! Probleem is opgelost!!