Rij verwijderen

[markoesa]

Beste kenners,

Ik heb onderstaande al een keer geplaatst, meer heb helaas geen reactie ontvangen. Daarom probeer ik het nogmaals.

Heb een werkmap met diverse sheets. In 1 sheet (Gegevensinvoer) zit de "rauwe data". De overige sheets zijn aan deze sheet gekoppeld.
Als ik nu een regel verwijder in het blad Gegevens invoer, krijg ik in de sommige sheets in een cel, de melding #VERW# of #NB# omdat de koppeling natuurlijk weg is.

Is er een mogelijkheid om mbv een macro de regels waar #VERW" of "NB# staat te verwijderen. Bijvoorbeeld dat de macro zoekt in A17:A1700 naar #VERW# of #NB# en vervolgens de hele rij verwijderd?

Alvast dank

 

[VenA]

Dit gaat toch prima met het autofilter. Filteren op de fouten en vervolgens de rijen selecteren en verwijderen. Anders svp een voorbeeldbestandje.

 

[markoesa]

Het zou met autofilter kunnen, maar het gaat om ongeveer 20 sheets. Ik had iets gevonden, maar het werkt niet. De melding "typen komen niet met elkaar overeen" verschijnt en bij de foutopsporing wordt de rood gemarkeerde regel geel. Geen idee wat er fout is is die regel. Mijn bedoeling is, om voor elk blad zo een macro te maken, omdat de fout niet in elk blad in kolom A voorkomt. Daarna wil ik de macro's onder 1 knop onderbrengen, zodat met 1 druk op de knop de "foute" regels verwijderd worden.

Sub Rij_verwijderen()
    Dim iLastRow As Long
 Dim i As Long
     iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
     For i = iLastRow To 17 Step -1
         [COLOR="#FF0000"][B]If Cells(i, "A").Value = "=Gegevensinvoer!#VERW!" Then[/B][/COLOR]
             Rows(i).Delete
          End If
     Next i
 End Sub

 

[VenA]

Probeer deze eens

Sub VenA()
For Each sh In Sheets
    For j = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If IsError(Evaluate(sh.Cells(j, 1).Formula)) Then sh.Cells(j, 1).EntireRow.Delete
    Next j
Next sh
End Sub

 

[markoesa]

@VenA, is dit voor alle sheets? Of moet ik bij Sheet(1) nog de sheetname aanpassen?

Heb getest op verschillende manieren, maar het werkt helaas niet.

Manier 1 In Sheet(naam tabblad), manier 2 In Sheet(nummer tabblad)

 

[VenA]

Sheet(1) is de eerste sheet in jouw bestand. Plaats even een voorbeeldje dat werkt wat makkelijker als je weinig van VBA weet.

 

[gast0660]

Hoi,

Probeer deze eens

Sub dotchie()
Dim lRow As Long
Dim iCntr As Long

lRow = Sheets("Uw blad naam").Range("L60000").End(xlUp).Row
' Hier 60000,Range aanpassen naar uw behoeften
' Uw blad naam = hier de naam van uw werkblad invullen

For iCntr = lRow To 1 Step -1
    If Cells(iCntr, 12) = "#VERW" Then ' Hier 12 is Kolum Number (L),#VERW, rijen waar #VERW in voorkomt worden verwijderd.
        Rows(iCntr).Delete
    End If
Next
End Sub

Anders wat venA zegt een voorbeeldje
Greetz

 

[VenA]

Code in #4 aangepast voor alle sheets.

 

[markoesa]

Bijgaand een voorbeeld bestandje. Het originele bestand heeft veel meer tabbladen en gegevens die gekoppeld zijn aan het tabblad Gegevensinvoer

Als er een rij verwijderd wordt uit Gegevensinvoer dan zouden de gegevens in Tabblad Code verwijderd moeten worden dmv de macro in dit tabblad

Helaas werkt het niet

 

[HSV]

Sub hsv()
Dim sh As Worksheet
For Each sh In Sheets
 On Error Resume Next
   sh.Rows.SpecialCells(-4123, 16).Delete
 On Error GoTo 0
Next sh
End Sub

 

[markoesa]

Beste Harry,

Natuurlijk dank voor je reactie. Heb je macro getest. Weet niet of ik het nog moet aanpassen, maar de macro doet er langer dan 5 min over, ik krijg dan een vraag over samengevoegde cellen, en op het laatst de vraag of een heel werkblad verwijderd moet worden

 

[HSV]

In je testbestand is het niet eens zichtbaar zo snel.

Verwijder de samengevoegde cellen.
Deze doen geen goed in een werkblad.

 

[VenA]

Volgens mij is het veel beter dat je de opzet van het bestand goed maakt. Voor een eenmalige opschoning werkt elke aangereikte oplossing wel ongeveer. Dat het jou zelf niet lukt is vrij bijzonder. Volgens mij was je sneller klaar met het even 'handmatig' opruimen van de 20 tabjes.

Na opschoning kan je beter zoiets gebruiken. Waarbij alleen formules voldoende zijn.

 

[markoesa]

Beste kenners,

Als eerst wil ik melden dat ik het bestand niet zomaar kan wijzigen qua opzet, omdat ik het "stokje" van iemand heb overgenomen. Het gaan om een fors klantenbestand van een vrijwilligers organisatie en ik probeer als vrijwilliger mijn "steentje" bij te dragen (met jullie hulp). Ik heb zitten rondstruinen en heb iets gevonden dat redelijk goed werkt. Voor elk werkblad heb ik een macro die de rijen verwijderd waarin in bijvoorbeeld #VERW! in voorkomt. In elk werkblad is het een andere kolom. De macro's werken voor elk werkblad apart wel goed, maar hopelijk is er een manier om ze aan elkaar te "knopen" en ze onder 1 knop onder brengen, zodat met een klik op de knop alle macro's uitgevoerd worden. Onderstaand een voorbeeld van 2 macro's van 2 werkbladen en mijn "probeersel" om ze elkaar te "knopen". Helaas werkt dit niet. Alleen de eerste macro wordt uitgevoerd. de rest niet. Kan iemand mij please helpen?

[QUOTE]Sub Rij_verwijderen_gegevensinvoer()
    Dim r As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("Gegevensinvoer").Select
    Set r = Range("O1:O750").Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
    On Error GoTo 0
    If Not r Is Nothing Then
        r.EntireRow.Delete
    End If
    Application.ScreenUpdating = True
End sub
-----------------------------------------
Sub Rij_verwijderen_uitdeelblad()
    Dim r As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("Uitdeelblad").Select
    Set r = Range("A1:A750").Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
    On Error GoTo 0
    If Not r Is Nothing Then
        r.EntireRow.Delete
    End If
    Application.ScreenUpdating = True
End Sub

Sub Combinatie()
Application.ScreenUpdating = False
  Rij_verwijderen_gegevensinvoer
  Rij_verwijderen_uitdeelblad
  Rij_verwijderen_tijdToekennen
  Rij_verwijderen_NaamopAlf
  Rij_verwijderen_verstrekenPeriode
  Rij_Leeftijd_deelnemers
  Rij_Historie_deelnemers
 ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("Uitdeelblad").Select
 Application.ScreenUpdating = True
End Sub[/QUOTE]

 

[HSV]

Kijk eens naar je gevonden code en die van mij (bijna identiek).
Misschien is dit nog iets sneller.

Sub hsv()
Dim sh As Worksheet
application.screenupdating = false
For Each sh In Sheets
 On Error Resume Next
   sh.UsedRange.SpecialCells(-4123, 16).EntireRow.Delete
 On Error GoTo 0
Next sh
End Sub

 

[markoesa]

Dank voor de reactie. Kan je misschien uitleggen wat jou macro doet? Dan leer ik er ook van

Vooral dit gedeelte sh.UsedRange.SpecialCells(-4123, 16)

 

[HSV]

Werkt het dan goed?

Sub hsv()
Dim sh As Worksheet 'declareren van variabele sh
application.screenupdating = false  ' updaten van screen uitzetten (flikkering), ook de code loopt sneller
For Each sh In Sheets   'loopje voor elk tabblad in je werkmap
 On Error Resume Next  'als er fouten onstaan op de volgende regel hieronder, loop dan door en stop niet bij een fout.
   sh.UsedRange.SpecialCells(-4123, 16).EntireRow.Delete  'cellen die formules bevatten met fouten in het gebruikte range van het werkblad op dat moment in de loop.
 On Error GoTo 0  'zet de foutafhandeling weer uit.
Next sh  'volgend tabblad bekijken, net zolang tot ze allemaal geweest zijn (for each sh in sheets).
End Sub

 

[markoesa]

Beste Harry

Met de stopwatch in de hand heb ik je macro getest. Duurde 3 min en 41 sec.

Ik heb wat speurwerk op youtube gedaan en kwam een manier tegen om macro's aan elkaar te "knopen". Heb de macro's die ik had ondergebracht in 1 macro.
Verbluffend resultaat: 47 seconden

Application.ScreenUpdating = False
    Run "Rij_verwijderen_gegevensinvoer"
    Sheets("Gegevensinvoer").Select
    Run "Rij_verwijderen_uitdeelblad"
    Sheets("Uitdeelblad").Select
    Run "Rij_verwijderen_tijdToekennen"
    Sheets("Tijd toekennen").Select
    Run "Rij_verwijderen_NaamopAlf"
    Sheets("Naam op alf").Select
    Run "Rij_verwijderen_verstrekenPeriode"
    Sheets("Verstreken periode").Select
    Run "Rij_Leeftijd_deelnemers"
    Sheets("Leeftijd deelnemers").Select
    Run "Rij_Historie_deelnemers"
    Sheets("Historie deelnemers").Select
    Sheets("Uitdeelblad").Select
    Application.ScreenUpdating = True
End Sub

Ik wil jou hartelijk danken voor de geboden hulp. Ik kom vast en zeker terug want ik begin het VBA gebeuren steeds leuker te vinden en op dit forum valt er heeellll wat te leren

 

[HSV]

Nogal wiedes dat het sneller werkt op een bepaalde range (A1:A750 en O1:O750 zie ik staan in jouw code) i.p.v. de gebruikte cellen (die mogelijk veel omvangrijker zijn).