Automatisch lege rijen in een bereik verwijderen

[HJ25]

Hallo,

ik heb in bijgevoegd bestand een code gezet die ik op dit forum gevonden heb. De code kijkt in A1:A20 of de rij leeg is en verwijdert deze lege rijen. Eigenlijk moet deze code vanaf A2 t/m D20 kijken of de rij leeg is. Vervolgens moeten de lege rijen verwijdert worden, maar moet er geen filter bovenaan komen te staan. Oftewel: alleen de lege rijen verwijderen. Wie kan hierbij helpen?

Hieronder de code:

Private Sub CommandButton1_Click()
    Range("A1:A20").AutoFilter
    ActiveSheet.Range("$A$1:$A$20").AutoFilter Field:=1, Criteria1:="="
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$A$20").AutoFilter Field:=1
End Sub

 

[spaarie]

Private Sub CommandButton1_Click()
  Dim b As Range, rows As Long, i As Long
  Set b = Range("A2:D20")
  rij = b.rows.Count
  For i = rij To 1 Step (-1)
    If WorksheetFunction.CountA(b.rows(i)) = 0 Then b.rows(i).Delete
  Next
End Sub

 

[HJ25]

Top! Bedankt spaarie!

 

[spaarie]

Druk op je knopje A t/m label in mijn voorbeeld...
Heb je opmaak namelijk aangepast.

Gerealiseerd door je hele macro te vervangen door:

Sub Macro1()
  Sheets(1).Range("F1:J" & Sheets(1).Range("F" & rows.Count).End(xlUp).Row).Copy Sheets(2).Range("A2")
  With Sheets(2)
    .Range("H3") = "08:00"
    .Range("I3") = "09:00"
    .Range("H3:I3").AutoFill .Range("H3:V3"), xlFillDefault
      For Each v In .Range("A2:A" & .Range("A" & rows.Count).End(xlUp).Row)
        v.Offset(, 6) = v
      Next
      For Each v In .Range("A4:E24")
        If v <> "" Then
        verschuiving = .Range("H:H").Column - v.Column
        v.Offset(, verschuiving).FormulaR1C1 = "=IF(OR(AND(R3C>=RC2,R3C<=RC3),AND(R3C>=RC4,R3C<=RC5)),1,"""")"
        End If
      Next
    .Range("H1:H20").AutoFill .Range("H1:V20"), xlFillDefault
    
  Set bereik = .Range("B4:E" & .Range("A" & rows.Count).End(xlUp).Row)
    For i = bereik.rows.Count To 1 Step -1
     If WorksheetFunction.CountA(bereik.rows(i)) = 0 Then bereik.rows(i).EntireRow.Delete
    Next
  End With
End Sub

 

[HJ25]

Super spaarie! Helemaal top! Ik heb in de andere vraag aangegeven dat ik nog een foutje heb gevonden, namelijk dat wanneer er tot 12:00 uur gebruikgemaakt wordt van deel A en vanaf 13:00 uur weer gebruikgemaakt wordt dan komt dit niet goed in de grafiek te staan. In de grafiek komt er dan te staan dat er gebruik is t/m 13:00 uur dus ook tussen 12:00 en 13:00 terwijl dit niet het geval is. Is hier een oplossing voor?

 

[spaarie]

Voor je grafiek moet ie er dan zo uit zien, maar is wel vertekenend in je kruistabel
=ALS(OF(EN(L$3>=$B4;L$3<$C4);EN(L$3>=$D4;L$3<$E4));1;"")

 

[HJ25]

Pff ik krijg opeens allemaal foutmeldingen bij die formule... Op zich maakt het niet uit hoe het in de tabel er uit komt te zien want uiteindelijk gaat het toch om de grafiek. Ik ga nog even verder met uitproberen!

Even voor de macro: wanneer ik ditzelfde voor deel B wil maken (waarbij de begin-en eindtijden in K1:N staan) hoe moet ik dan dat bereik wat nu als F1:J staat aanpassen? Bij deel B krijg je dus 2 bereiken die gekopieerd moeten worden.

 

[spaarie]

Voor je module

"=IF(OR(AND(R3C>=RC2,R3C<RC3),AND(R3C>=RC4,R3C<RC5)),1,"""")"

Dan pak je toch de hele range van F1:N?

 

[HJ25]

Maar dan komen ook de gegevens van deel A er bij terwijl deze niet nodig zijn, maar hier verzin ik dan nog wel wat op. Daarnaast kan de formule in de tabel niet meer geplaatst worden wanneer ik een bereik laat kopiëren dat t/m kolom H komt.