Laatste 'lege' formule-regel moet blijven staan.

[origami123]

Goedenavond,

Ik heb een probleem met twee macro's, die elkaar dwars liggen.

Ik ben bezig met het vullen van een lijst, waarvan automatisch een regel - met formules - wordt toegevoegd bij invoer van een cel in de onderste regel d.m.v. een macro in ThisWorkbook: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Voor de lege regels die door gebruik van de lijst zich voordoen, heb ik ververs-macro, die de lijst opschoont.

Tot zover niets nieuws, echter, als ik de ververs-macro activeer, wordt ook de allerlaatste lege regel gewist, met daarin de gecopieerde formules.

Geen nood, dacht ik, want dan bouw ik in de ververs-macro even een stukje code, die deze regel alsnog weer doet verschijnen, maar dit werkt niet.

Los van elkaar werken de 'lege regel verwijdering' en de 'regel-toevoeging' prima, maar als ze achter elkaar hun werk moeten doen, dan kom ik niet bij de tweede macro.

Hij blijft hangen op: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) in ThisWorkbook.
Schijnbaar omdat deze macro hetzelfde doet vanuit ThisWorkbook, dus een regel toevoegen indien nodig, zit daar volgens mij het euvel.


Zelfs als ik de beide macro's achter elkaar activeer via knoppen, dan doet de macro voor de nieuwe regel niets.
Er komt pas weer beweging in als ik een andere actie onderneem, bijv, opslaan.

Zelfs tussen twee losse macro's in heb ik dus een 'break' nodig om de tweede macro zijn werk te kunnen laten doen.

Aangezien het bovenstaande allebei automatisch dient te gebeuren, heb ik hier dus een probleem.

Ik zou eigenlijk helemaal geen tweede macro nodig moeten hebben, maar dan moet ik een code hebben, die wel de lege rijen verwijdert, maar de onderste lege regel met formules gewoon laat staan en die krijg ik niet voor elkaar.

Wellicht iemand, die daar een oplossing voor heeft? B.v.d.


M.vr.gr.

Origami.

 

[oeldere]

Waarschijnlijk wordt je door VBA kenners beter geholpen, indien je je code (tussen codetags) plaatst.

Zelf kan ik je onvoldoende helpen met VBA.

 

[origami123]

Oeldere,

Je hebt gelijk, bij deze de beide macro's
Los van elkaar werken ze prima, maar na macro1 wordt macro2 niet meer gestart.

Macro1:

Sub LegeRijen()
   Application.ScreenUpdating = False
     On Error Resume Next
   Range("B8:C65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
    On Error GoTo 0
   Application.ScreenUpdating = True
   Range("B7").Select
End Sub

Macro2:

Sub ExtraOndersteRegel()
    If Cells(ActiveCell.Row + 1, 2) <> "" Then Exit Sub
    If Cells(ActiveCell.Row + 1, 3) <> "" Then Exit Sub
    Application.ScreenUpdating = False
    Range("B7").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Select
    ActiveCell.EntireRow.Copy
    ActiveCell.Offset(1, 0).EntireRow.Insert
    With Selection
         .PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False         
    End With
    Cells(ActiveCell.Offset(1, 0).Row, 2).Select
        Selection.ClearContents
    Cells(ActiveCell.Offset(0, 0).Row, 3).Select
        Selection.ClearContents
    Cells(ActiveCell.Offset(0, 0).Row, 5).Select
        Selection.ClearContents  
  Range("B7").Select
  Application.CutCopyMode = False
  Application.ScreenUpdating = True  
End Sub

 

[oeldere]

Zelf ben ik geen VBA kenner, maar ik lees de items hierover wel.

Misschien kun je de laatste (gevulde) cel laten zoeken.

Vanaf daar 2 rijen omhoog gaan => daarmee sla je de lege regel over.

En vanaf daar de lege regels (naar boven) toe verwijderen.

 

[origami123]

Inderdaad, heb ik al geprobeerd, maar dan staat de range waarin moet worden gezocht en gewist niet meer vast.
Ik heb geprobeerd, dat te vangen in de Range-selectie, maar dat krijg ik dus niet voor elkaar.
Ik zal het wel te ver zoeken.

Eigenlijk mag de range ook niet vast staan, want het is nooit bekend, hoe lang de lijst is/wordt.
Bovendien hoeven er dan ook geen duizenden regels, die toch al leeg zijn te worden gecontroleerd.

Dus vandaar vang ik - om safe te spelen - tot nu toe alles in een vaste range van B8:C65536

 

[oeldere]

Wacht de reactie van VBA kenners maar even af.

Ik ben benieuwd naar hun oplossing(en).

 

[origami123]

Inderdaad, we wachten even af.

Heb er intussen - voor dit item - al wat uurtjes inzitten.
Een oplossing zou zeer welkom zijn en ben benieuwd in welke hoek die zit.

 

[ExcelAmateur]

origami123,

Als je het zo probeerd, zie het rode.
Hij word nu naar Macro 2 gestuurd.

Sub LegeRijen()
   Application.ScreenUpdating = False
     On Error Resume Next
   Range("B8:C65536").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
    On Error GoTo 0
   Application.ScreenUpdating = True
   [COLOR="#FF0000"]ExtraOndersteRegel[/COLOR]   
   Range("B7").Select
End Sub

 

[origami123]

ExcelAmateur,

bedankt voor je reactie.

Ook jouw oplossing heb ik al geprobeerd en eveneens via 'call ExtraOndersteRegel' en ik heb zelfs de twee macro's genest, maar zodra de code wordt aangesproken om een nieuwe regel toe te voegen, ontstaat er ergens een probleem.

En Macro2 wordt in alle gevallen wel aangesproken, maar hij stopt tijdens de verwerking en volgens mij ergens in conflict met de macro in ThisWorkbook: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range), die staat ingesteld om automatisch eigenlijk hetzelfde te doen.

Hierdoor kan ik ook geen 'On Error goto' inbouwen, want er is dus geen fout en er wordt daarom ook niets gemeld.

Uit zichzelf eindigt de macro niet - hij wacht ergens op of wordt tegengehouden - , maar als ik hem onderbreek, door bijv. opslaan aan te klikken en ik klik dan opnieuw op macro2, dan is er niks mee en gaat hij als een trein.

Macro2 in of direct na macro1 werkt dus in die volgorde niet naar behoren, maar andersom is er geen probleem.

De macro in ThisWorkbook: Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) en Macro2 doen eigenlijk hetzelfde, echter de eerste automatisch en Macro2 op aanvraag, maar Macro2 triggert schijnbaar de eerste en blijft daarin hangen.

 

[ExcelAmateur]

Heb je ook al geprobeerd om het met een Module te doen?

 

[origami123]

De bewuste macro's bevinden zich al in modules en zijn dus niet tabblad-gebonden.

Ze worden aangesproken via een knop om de lijst te verversen en dus van lege regels te ontdoen, waarna de nieuwe regel moet worden toegevoegd, maar het resultaat kennen we.

Maar zelfs als ik eerst Macro1 draai en dan met een tweede knop macro2, dan doet hij het ook niet.
Macro1 haalt regels weg, die de automaat-macro in This Workbook waarschijnlijk tegelijkertijd juist wil toevoegen en daar stopt het.
Alleen een 'break' lost de boel op en dan kan Macro2 pas zijn werk doen.

 

[origami123]

Ik denk het probleem van de niet werkende Macro2 te hebben gevonden.

Deze mag alleen werken vanaf de allerlaatste regel, want anders zouden er regels worden tussengevoegd, wat niet de bedoeling is.

Na het wissen van de lege regels moet dus de ActiveCell in de B-kolom van de allerlaatste rij terecht komen en dat doet hij niet.

Maar hoe ik ook probeer om die onderste cel de actieve cel te maken, het lukt me niet.

In macro2 had ik daarom de volgende code ingelast, waarvan ik dacht dat dat 'm was:

     Range("B8:B").Select
     ActiveCell.SpecialCells(xlLastCell).Select

maar dat werkt dus niet.

 

[origami123]

Ik heb de code met foutopsporing nagelopen en in de rode regels springt de macro vanuit de module meerdere malen heen en terug naar Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) in ThisWorkbook.

Waarom, dat kan ik niet achterhalen en is ook niet de bedoeling, maar gaat het wel fout.

Macro2:

Sub ExtraOndersteRegel()
    If Cells(ActiveCell.Row + 1, 2) <> "" Then Exit Sub
    If Cells(ActiveCell.Row + 1, 3) <> "" Then Exit Sub
    Application.ScreenUpdating = False
    Range("B7").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.EntireRow.Select
    ActiveCell.EntireRow.Copy
 [COLOR="#FF0000"]   ActiveCell.Offset(1, 0).EntireRow.Insert
    With Selection
         .PasteSpecial Paste:=xlFormulas, Operation:=xlNone, _
         SkipBlanks:=False, Transpose:=False         
    End With
    Cells(ActiveCell.Offset(1, 0).Row, 2).Select
        Selection.ClearContents
    Cells(ActiveCell.Offset(0, 0).Row, 3).Select
        Selection.ClearContents
    Cells(ActiveCell.Offset(0, 0).Row, 5).Select
        Selection.ClearContents  [/COLOR]
  Range("B7").Select
  Application.CutCopyMode = False
  Application.ScreenUpdating = True  
End Sub

 

[origami123]

Het is gelukt om de in de laagste rij gevulde cel in kolom B te selecteren.

Daarvoor heb ik nu eens niet van boven naar beneden, maar vanaf ("B65536") naar boven toe laten zoeken op onderste gevulde cel.

En vanaf die plaats komt hij wel met een nieuwe - van formules voorziene - 'lege' regel, hetgeen ook precies de bedoeling was.

Alles werkt nu naar wens.

De toegepaste code:

    Range("B65536").Select
    Selection.End(xlUp).Select

Iedereen vriendelijk bedankt voor het meedenken.

M.vr.gr.

Origami