VBAcode " lege rijen verwijderen" versnellen

[AD1957]

Met onderstaande code verwijder ik lege rijen in het bereik "A"
Duurt echter vrij lang.
Weet iemand een code die sneller werkt

Dim j As Long
With ActiveWorkbook.Sheets("Blad2")
     For j = 2000 To 1 Step -1
         If .Cells(j, "A") = "" Then
             .Cells(j, "A").EntireRow.Delete
         End If
     Next j
End With

 

[mvdvlist]

Lege rijen verwijderen

Is dit een optie?
Verwijdert alleen lege cellen, maar kun je verder zelf aanpassen natuurlijk.

Blad1.Range("A1:A2000").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

Succes,

Opa Maarten

 

[edmoor]

Of probeer dit eens:

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Blad2").Range("A1:A2000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[AD1957]

Deze gaat ook al heel wat rapper,(hier gevonden met dank aan Spiderman) de code van jou zal ik ook nog eens testen.
Bedankt voor de reactie

With ActiveWorkbook.Sheets("Blad2")
Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For X = LastRow To 1 Step -1
If Range("A" & X).Value = "" Then Range("A" & X).EntireRow.Delete
Next

 

[AD1957]

code zou toch eigenlijk moeten werken onder de opdrachtknop op blad 1, hij werkt wel als ik hem in een commandbutton op blad 2 zet

Dim i As Integer
For i = 2 To 2000
If DatePart("q", Cells(selrij & i + 1, 1)) = 2 Then
    
    Sheets("Blad2").Cells(selrij & i + 1, 1).Value = Cells(selrij & i + 1, 1).Value 'datum
    Sheets("Blad2").Cells(selrij & i + 1, 2).Value = Cells(selrij & i + 1, 2).Value 'nummer
    Sheets("Blad2").Cells(selrij & i + 1, 3).Value = Cells(selrij & i + 1, 3).Value 'naam
    Sheets("Blad2").Cells(selrij & i + 1, 4).Value = Cells(selrij & i + 1, 4).Value 'bruto
    Sheets("Blad2").Cells(selrij & i + 1, 5).Value = Cells(selrij & i + 1, 5).Value 'btw
    Sheets("Blad2").Cells(selrij & i + 1, 6).Value = Cells(selrij & i + 1, 6).Value 'netto
    
End If
Next

'Sheets("Blad2").Activate

With ActiveWorkbook.Sheets("Blad2")
'Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
For X = LastRow To 1 Step -1
If Range("A" & X).Value = "" Then Range("A" & X).EntireRow.Delete
Next
End With

Sheets("Blad2").Select

 

[edmoor]

Ik had m'n bericht aangepast i.p.v. een nieuwe te plaatsen.
Probeer dit eens:

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Blad2").Range("A1:A2000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[AD1957]

Hoi Ed,
deze laatste van jou werk ook onder de commandbutton op blad 1
Moet toch eens gaan uitzoeken waar het fout gaat.

Application.ScreenUpdating = False
ActiveWorkbook.Sheets("Blad2").Range("A1:A2000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

 

[edmoor]

Klopt, maar doet z'n werk op Blad2.
Bij jouw code werkt dat niet omdat je geen punt hebt staan voor Range binnen de With.

 

[AD1957]

Bedankt voor de info, die punt doet 't 'm :thumb:
Ik ga nu maar stoppen anders zit ik om 2.00uur nog voor het scherm.
Fijne avond nog.

 

[edmoor]

Graag gedaan en hetzelfde gewenst

 

[VenA]

Plaats een voorbeeldbestand en de hele code zal/kan gereduceerd worden tot een paar regels. Waarom is

For i = 2 To 2000

2000 een heilig getal? bij 100 rijen doorloop je het onnodig vaak. Bij 2005 rijen en eerder ga je data missen.

 

[AD1957]

Goede Morgen VenA,

i =1 to 2000 is niet heilig, maar ik heb het verkoopboek gemaakt met 2000 regels.(zeker aan de hoge kant, maar wel toekomstbestendig)
Met een tabel in het verkoopboek liep ik tegen allerlei problemen aan (zie eerdere vragen van mij op dit FORUM)
Waarschijnlijk is het in de ogen van de profs een zootje.

Ik zal proberen een goed gelijkend voorbeeldbestand te plaatsen (moet eerst nog anonimiseren)
Als voorbeeldbestand zet ik alleen het verkoopboek en factuur.
p.s. heb inmiddels gemerkt dat het verwijderen van lege rijen niet altijd correct verloopt.

 

[edmoor]

p.s. heb inmiddels gemerkt dat het verwijderen van lege rijen niet altijd correct verloopt.

Met mijn voorbeeld in #6 kan het eigenlijk niet missen.
Dan inderdaad een voorbeeld document.

 

[AD1957]

hier dan een voorbeeldbestand.
Tot nog toe heb ik slechts 1 probleem geconstateerd.

Commandbutton(totaaltelling en afdrukvoorbeeld) op blad 2 geeft slechts 1 pagina
Of er verder nog problemen komen????, waarschijnlijk tijdens testen dat ik nog wat ga vinden.

Wel wil ik nog opmerken dat ik eerst heb geprobeerd om in het verkoopboek met een tabel te werken,
kwam dan echter in de problemen met Userform2.

update:
Ook het boeken van facturen gaf problemen, nml. facturen werden in verkeerde rij geboekt bij toepassing van tabel

 

[AD1957]

update:
Vreemd
In de PrintPreview zie ik slechts de 1e pagina
Echter de selectie wordt wel volledig afgedrukt

 

[AD1957]

Inmiddels ben ik zover dat ik het oude concept heb verlaten.
Toch maar weer overgestapt naar een tabel, werkt gewoon veel beter
Echter 1 probleem:
Ik krijg het niet voor elkaar om de factuur te boeken in de tabel, deze wordt geboekt onder de tabel.
Als ik in de laatste rij van de tabel de subtotaaltelling weglaat werkt het wel.

 

[VenA]

Wat heeft het hele verhaal te maken met de vraag? Maak een concreet voobeeldbestand met daarin alleen de code die van toepassing is op de vraag. Om elke keer jouw bestanden te analyseren en er dan achter te komen dat de code waar je het over hebt er niet instaat werkt niet echt motiverend.
Hoe eenvoudiger jij zelf je voorbeelden en deelproblemen zichtbaar kan maken hoe meer kennis je zelf opdoet.

 

[AD1957]

Mijn excuus voor de onduidelijkheid en overtollige informatie.
Hoop dat het voorbeeldbestand nu duidelijker is.
Vraag:
Hoe krijg ik het voor elkaar om de factuur te boeken binnen de tabel in het verkoopboek.
Nu wordt de regel onder het subtotaal van de tabel geboekt.
Ik gebruik deze code onder de commandbutton"boeken factuur" op het blad factuur.

Private Sub CommandButton4_Click() ' BOEKEN FACTUUR
    Sheets("verkoopboek").Cells(Rows.Count - 1, 1).End(xlUp).Offset(1).Resize(, 9) = Array(Range("F18").Value, Range("F20").Value, Range("F21").Value, _
    Range("B20").Value, Range("F77").Value, Range("F75").Value, Range("D75").Value, Range("F76").Value, Range("D76").Value)
End Sub

p.s. ik hoop dat het nu wel duidelijk is

 

[roeljongman]

Met de totaalrij onder een exceltabel kun je uiteraard niet de standaard truc gebruiken dat je de laatst gevulde regel opzoekt van onder de tabel

dus je moet een andere benadering gebruiken. en ook moet je even een datarij invoegen voordat de data geplakt wordt.

de macro ziet er dan zo uit.

Private Sub CommandButton4_Click() ' BOEKEN FACTUUR


    With Sheets("verkoopboek").Cells(2, 1).End(xlDown)
            .ListObject.ListRows.Add AlwaysInsert:=True
            .Offset(1).Resize(, 9) = Array(Range("F18").Value, Range("F20").Value, Range("F21").Value, _
    Range("B20").Value, Range("F77").Value, Range("F75").Value, Range("D75").Value, Range("F76").Value, Range("D76").Value)
    End With
End Sub

De code .ListObject.ListRows.Add AlwaysInsert:=True zorgt dat er op de laatste rij van de tabel (net boven de totaalrij) een rij wordt toegevoegd aan de tabel

daarna doet de offset.resize.. enz hetzelfde als in jou eerdere code

 

[VenA]

Ik zou het helemaal binnen de tabel houden.

Private Sub CommandButton4_Click() ' BOEKEN FACTUUR
  With Sheets("verkoopboek").ListObjects(1)
    .ListRows.Add
    .Range.Cells(.ListRows.Count, 1).Offset(1).Resize(, 9) = Array(Range("F18").Value, Range("F20").Value, Range("F21").Value, _
      Range("B20").Value, Range("F77").Value, Range("F75").Value, Range("D75").Value, Range("F76").Value, Range("D76").Value)
  End With
End Sub