als celwaarde > 0, dan rij invoegen en format formules kopiëren

ebonk · 6 mrt 2014

Hallo,

Ik werk met Excel 2010, als complete beginner.

Ik probeer een macro te maken die 1 rij invoegt onder de actieve cel wanneer de celwaarde die wordt ingegeven > 0 en daarbij de formules (niet de content) van de cellen in de volgende kolommen mee kopieert.

Ik weet niet hoe ik best de sub moet starten.

Hierbij een voorbeeld, zonder de formules, enkel de voorwaarde om een rij in te voegen (dat kan later nog volgen):

Code:

Sub ifthenshizzle()

Dim Mynumber As Long

Mynumber = 0

If Mynumber > 0 Then

ActiveCell.EntireRow.Insert

End If

End Sub

Dit werkt echter niet...

Zou het mogelijk zijn om er eens naar te kijken, aub?

Alvast veel dank!

groetjes,

ebonk

edmoor · 7 mrt 2014

Die routine is op zich niks mis mee. Maar dat die geen rij invoegt is logisch. Je zet Mynumber op 0 en vervolgens zeg je dat er een rij moet worden ingevoegd als Mynumber groter is dan 0.

Hoe laat je de routine starten?

ebonk · 7 mrt 2014

Beste edmoor,

Vooreerst dank voor je reactie.

De bedoeling is dat er niets gebeurt bij 0, maar dat er een rij wordt toegevoegd wanneer er een ander getal (> 0) wordt ingevoerd.

Verder weet ik net niet hoe de routine te laten starten, dus dat is de vraag.

groetjes,

ebonk

edmoor · 7 mrt 2014

Het zou een script moeten zijn dat wordt gestart door een wijiziging in je werkblad, dus een Private Sub Worksheet_Change(ByVal Target As Range)
Hierin controleer je dan of de active cell in een bepaalde range valt en voer je de bedoelde code uit als dat zo is. Kijk voor voorbeelden eens hier:
http://www.ozgrid.com/VBA/run-macros-change.htm

ebonk · 9 mrt 2014

Dag Edmoor,

Fantastisch! Heeft gewerkt! Hiermee ben ik al een hele stap vooruit.

Tot hier toe heb ik het voorbeeld aangepast zodat er effectief een rij wordt ingevoegd en dit wanneer je gelijk waar in kolom A (Range("$A$1:$A$1048576")) een getal invoegt in een actieve cel (bij een letter gebeurt er niets).

Probleem is nu dat het ingevoerde getal niet blijft staan, maar dat er "TRUE" komt te staan in de plaats...

Heb je daar een oplossing voor, aub?

Eens ik daaruit ben kan ik gaan puzzelen aan hoe ik de formules doorgetrokken krijg uit de rij waaronder een rij wordt ingevoegd.

maar stap voor stap.

Alvast veel dank voor je ondersteuning en voor de stappen die al gezet zijn met je tips!

Ik plak hieronder nog even wat ik in een testbestand uitwerkte.

groetjes,

Ebonk

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

   'Do nothing if more than one cell is changed or content deleted

   If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

    ' range in which the sub should work = column A
    
    If Not Intersect(Target, Range("$A$1:$A$1048576")) Is Nothing Then

       'Ensure target is a number AND is > 0

        If IsNumeric(Target) And Target > 0 Then
        
            'Stop any possible run1ime errors and halting code

            On Error Resume Next

                'Turn off ALL events so the "Target -> insertrow"  does not put the code into a loop.

                Application.EnableEvents = False

                Target = ActiveCell.Offset(1).EntireRow.Insert

                'Turn events back on

                Application.EnableEvents = True
                
            'Allow run time errors again

            On Error GoTo 0

        End If

    End If

      

End Sub

edmoor · 9 mrt 2014

Hoi,

Dat komt door de regel die begint met Target =
Ik heb de code even voor je aangepast en ook het ophalen van de laatst gebruikte regel geregeld. Zo hoeft deze niet vast in de code te worden opgenomen met een heel hoog getal.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
        If Not Intersect(Target, Range("$A$1:$A$" & ActiveSheet.UsedRange.Rows.Count)) Is Nothing Then
        If IsNumeric(Target) And Target > 0 Then
            On Error Resume Next
            Application.EnableEvents = False
            ActiveCell.Offset(1).EntireRow.Insert
            Application.EnableEvents = True
            On Error GoTo 0
        End If
    End If
End Sub

Plaats een evt. volgende keer ook je code in een codetag, zoals mijn voorbeeld hier.

huijb · 9 mrt 2014

Visual Basic is iets anders dan Visual Basic for Applications, VBA is programmeren binnen Office applicaties. Verplaatst naar juiste sectie.

snb · 10 mrt 2014

Gebruik gewoon een tabel in het werkblad, dan gaat dit alles automatisch.

ebonk · 10 mrt 2014

@huijb: hoe kan ik mijn topic verplaatsen, aub? Of doet de moderator dat? Dank voor je bemerking.

@ snb: hoe werkt dat met die tabellen, aub? Ik heb dat nog eens als tip gekregen, maar helaas nog niet van gehoord. echter beginner.

@ Edmoor: nu heb ik volgende code (die werkt), waarmee een rij wordt ingevoegd en ook de waarde in de aanvankelijke cel komt (door target te verwijderen):

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Do nothing if more than one cell is changed or content deleted

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

' range in which the sub should work = column A
If Not Intersect(Target, Range("$A:A")) Is Nothing Then
    'Ensure target is a number AND is > 0
    If IsNumeric(Target) And Target > 0 Then
        'Stop any possible run1ime errors and halting code
        'On Error Resume Next
        'Turn off ALL events so the "Target -> insertrow" does not put the code into a loop.
        Application.EnableEvents = False
        ActiveCell.EntireRow.Insert
        'Turn events back on
        Application.EnableEvents = True
        'Allow run time errors again
        'On Error GoTo 0
    End If
End If

Echter, nu zou ik de formules willen laten doortrekken, bijvoorbeeld zo:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

'Do nothing if more than one cell is changed or content deleted

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

' range in which the sub should work = column A
If Not Intersect(Target, Range("$A:A")) Is Nothing Then
    'Ensure target is a number AND is > 0
    If IsNumeric(Target) And Target > 0 Then
        'Stop any possible run1ime errors and halting code
        'On Error Resume Next (deleted)
        'Turn off ALL events so the "Target -> insertrow" does not put the code into a loop.
        Application.EnableEvents = False
        ActiveCell.EntireRow.Insert
        'Turn events back on
        Application.EnableEvents = True
        'Allow run time errors again
        'On Error GoTo 0
    End If
End If

'hiermee zou ik twee kolommen "doortrekken", nl. deze rechts van de active cell en een verder:

Range(Cells(ActiveCell.Offset(, 1)), Cells(ActiveCell.Offset(, 2))).FillDown

End Sub

Code:

Ik krijg echter een foutmelding.

Wat doe ik hier verkeerd, aub?

PS: ik had ook nog een oplossing gevonden die met "with" werkt en dan .insert.shift, .copy en .paste, maar filldown leek me korter...

Alvast bedankt voor jullie antwoord!

groetjes,

Enoch

edmoor · 10 mrt 2014

Vergelijk eerst even de leesbaarheid van je code met die van mij op #6 en lees ook even de regel eronder. Hier is zo geen wijs uit te worden. Tevens, als je zegt een foutmelding te krijgen is het wel zo handig deze ook even te vermelden.

Gebruik van tabellen is inderdaad veel eenvoudiger als je daar voldoende aan hebt:
http://www.jkp-ads.com/articles/Excel2007TablesNL.asp

Warme bakkertje · 11 mrt 2014

Het gebruik van tabellen buiten beschouwing gelaten, heb je in de VBA-Help de correcte syntax van FillDown al eens opgezocht.
Had je dit gedaan had je zelf een antwoord op je vraag gevonden.

ebonk · 11 mrt 2014

Beste Edmoor,

Hierbij alvast een gekuiste versie:

Ik zou zo een codevenster willen maken en gebruik de tag # code, maar dit schijnt geen venster op te leveren... gebruik ik een andere tag?

code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Not Intersect(Target, Range("$A:A")) Is Nothing Then

If IsNumeric(Target) And Target > 0 Then

Application.EnableEvents = False

ActiveCell.EntireRow.Insert

Application.EnableEvents = True

End If
End If

Range(Cells(ActiveCell.Offset(, 1)), Cells(ActiveCell.Offset(, 2))).FillDown

code:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Not Intersect(Target, Range("$A:A")) Is Nothing Then

If IsNumeric(Target) And Target > 0 Then

Application.EnableEvents = False

ActiveCell.EntireRow.Insert

Application.EnableEvents = True

End If
End If

Range(Cells(ActiveCell.Offset(, 1)), Cells(ActiveCell.Offset(, 2))).FillDown

@ warme bakkertje:

Ik heb de syntax bekeken en kom het volgende uit:
Syntax

expression.FillDown

expression A variable that represents a Range object.

Probleem hiermee is dat ik er niet in slaag de Range correct uit te drukken.

Ik probeerde ook al:

Code:

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 2)).FillDown

Code:

maar dat verwijst naar de rij zelf, zonder dat ik binnen de syntax ook de volgende rij kan definiëren tot waar mag ingevuld worden.

@snb:

bij tabellen, kan je dan ook automatisch een rij laten invoegen eens een waarde wordt ingevuld, zoals bij worksheet, aub?

Nogmaals dank aan allen!

groetjes

ebonk

ebonk · 11 mrt 2014

Hallo,

Uiteindelijk een andere optie gevonden om formules in twee kolommen door te trekken.

Nu had ik graag in de sheet bepaalde cellen beveiligd en andere toegankelijk gelaten en ervoor gezorgd dat de macro toch zijn werk doet en niet gehinderd wordt door het paswoord. Via opzoeking kwam ik op het volgende, maar wordt niet aanvaard... Iemand een suggestie, aub? Wat doe ik hier verkeerd, aub?

Alvast dank!!!

groetjes ebonk

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect Password("test123")

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

If Not Intersect(Target, Range("$A:A")) Is Nothing Then

If IsNumeric(Target) And Target > 0 Then

Application.EnableEvents = False

ActiveCell.EntireRow.Insert

Application.EnableEvents = True

End If
End If

ActiveCell.Resize(1, 3).Select

Selection.FillDown

ActiveSheet.Protect Password("test123")

End Sub

Ik probeerder ook al

ActiveSheet.Protect Password = "test123"

Warme bakkertje · 12 mrt 2014

Code:

ActiveSheet.Unprotect "test123"
ActiveSheet.Protect "test123"

ebonk · 13 mrt 2014

Hello

Dit heeft allemaal goed geholpen. Dankjewel, veel geleerd! Alles werkt naar behoren.

Dank julllie wel!

groetjes,

ebonk

snb · 14 mrt 2014

En nu nog even code tags teovoegen voor de leesbaarheid.

snb · 14 mrt 2014

En nu nog even code tags toevoegen voor de leesbaarheid.

als celwaarde > 0, dan rij invoegen en format formules kopiëren

ebonk

Gebruiker

edmoor

Inventaris

ebonk

Gebruiker

edmoor

Inventaris

ebonk

Gebruiker

edmoor

Inventaris

huijb

Supermoderator

snb

Verenigingslid

ebonk

Gebruiker

edmoor

Inventaris

Warme bakkertje

Meubilair

ebonk

Gebruiker

ebonk

Gebruiker

Warme bakkertje

Meubilair

ebonk

Gebruiker

snb

Verenigingslid

snb

Verenigingslid

Nieuwste berichten

Wij waarderen jouw privacy