VBA code rijen invoegen door elkaar

[boomen]

@snb: Mijn Niveau op VBA is nog niet zo ver dat ik zelf een hele code naar gelang kan aanpassen/zelf schrijven.
Ik zoek veel op en pas aan waar ik denk de stukken code helemaal te snappen.
Bij errors tik ik die hier op het Forum in en kom ik vaak al heel ver.
Ik weet dus niet zo goed waar je het nu over hebt, snapt best dat je nooit Meer rijen krijgt dan er zijn Maar dan voeg je toch eigenlijk nooit iets in? Is daar nog een wezenlijk verschil in qua code?
Wel bedankt voor het meedenken/aan het denken zetten!

Edit: bedoel je misschien de formules op blad direct linken aan blad 1 en dan iedere keer dat stuk gegevens letterlijk plakken?
Dan moet je dus alle gegevens eronder ook verplaatsen.

Grtz

 

[Niels28]

Kort voorproefje wat ik in gedachte heb,
Klopt nog niet helemaal, gaat nog fout als je met meststoffen begint , kijk er even naar, meld me vanmiddag weer.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.8.9.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.8b.9b.", Target) > 0 And Target <> "" Then
  
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
               
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(4, 1)
            Next n
    End If
    End If
    Cancel = True
  
   Set r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp)
    Set r1 = r.End(xlUp)

    'Range("B" & r.End(xlUp).Row & ":R" & r.Row).Select
    ActiveWorkbook.Worksheets("Kostenoverzicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Kostenoverzicht").Sort.SortFields.Add Key:=Range(r1.Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Kostenoverzicht").Sort
        .SetRange Range("B" & r.End(xlUp).Row & ":R" & r.Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



    
End Sub

Niels

 

[boomen]

Ik ga ermee beginnen. Wel weer een hoop nieuwe dingen dus eerst even uitzoeken wat alles doet
bedankt!

grtz

 

[boomen]

Ik heb nog steeds de fout ook al begin ik met bestrijdingsmiddelen.
Na het verwijderen van de ingevoegde rijen heb ik 4 bestrijdingsmiddelen ingevoerd en 4 meststoffen.
De bestrijdingsmiddelen gebruikte G16 zoals het hoort bij de 1e en daarna G12.
De meststoffen pakken allemaal G18.
Het gaat dan dus om de cellen E18 t/m E25 blad 1 na het invoegen van de 8 eerdergenoemde formulereeksen.

 

[Niels28]

verander de formule in E5 op het formule blad zodat deze naar $G3 verwijst.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 And InStr("2.3.4.5.6.7.8.9.", Target) > 0 And Target <> "" Then
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
                Target.Offset(4).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules].Copy Target.Offset(4, 1)
            Next n
        End If
    End If
    Cancel = True
    
     If Target.Column = 1 And InStr("2b.3b.4b.5b.6b.7b.8b.9b.", Target) > 0 And Target <> "" Then
  
        i = InputBox("hoeveel rijen invoegen?")
        If i > 0 And IsNumeric(i) Then
            For n = 1 To i
               
                Target.Offset(3).Resize(1, 18).Insert Shift:=xlDown   ', CopyOrigin:=xlFormatFromLeftOrAbove
                [formules1].Copy Target.Offset(3, 1)
            Next n
    End If
    End If
    Cancel = True
  
   Set r = Target.End(xlDown).Offset(, 1).End(xlUp).End(xlUp)
    Set r1 = r.End(xlUp)

If r1.Row < Target.Row + 3 Then Exit Sub

   For Each Rng In Range("E" & r.End(xlUp).Row & ":E" & r.Row)
 
        Rng.Formula = Replace(Rng.Formula, "$G", "$G$")
        
    Next Rng

    ActiveWorkbook.Worksheets("Kostenoverzicht").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Kostenoverzicht").Sort.SortFields.Add Key:=Range(r1.Address), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Kostenoverzicht").Sort
        .SetRange Range("B" & r.End(xlUp).Row & ":R" & r.Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub

Wat ik doe is de formule plaatsen, de verwijzing naar de zoekwaarde in kolom G absoluut maken en dan sorteren.

Niels

 

[boomen]

Hij doet het bijna.
Hij sorteerd hem goed na de 1e keer.
Bij 2 keer een meststof invoeren krijg ik de volgende foutmelding:
Fout 1004 tijdens uitvoering:

Door de toepassing of door object gedifineerde fout

Als ik dan op beeindigen druk pakt die hem wel Maar zet die hem boven de bestrijdingsmiddelen.

Edit: Bij foutopsporing geeft die het volgende aan:

Rng.Formula = Replace(Rng.Formula, "$G", "$G$")

grtz

 

[Niels28]

logisch

  For Each Rng In Range("E" & r.End(xlUp).Row & ":E" & r.Row)

        If Mid(Rng.Formula, 12, 1) <> "$" Then Rng.Formula = Replace(Rng.Formula, "$G", "$G$")
        
    Next Rng

Niels

 

[boomen]

Net even getest in mijn eigen model en werkt perfect!
Je hebt nog een paar lintjes tegoed, zal ze bewaren voor je.

Dat sorteren gaat mijn pet nog teboven, Maar was toevallig in mijn boek bij .End(xlUp) en dergelijke. Dus die is voor mij ook duidelijk.

iig bedankt

grtz

 

[boomen]

Te vroeg gejuicht

Als ik eerst bestrijdingsmiddelen invoer en dan meststoffen krijg ik bij de gegevensvalidatie van de bestrijdingsmiddelen de opties van de meststoffen en andersom.
Edit: de formules Enzo kloppen wel. Alleen de validatiecell dus niet.

 

[Niels28]

Je kunt juichen en te vroeg juichen wat je wilt maar plaats dan eens een complete bijlage.
Er staat geen gegevens validatie in je voorbeeldbestand. En ook die zou je indirect kunnen doen dus heb je aan 1 validatie voldoende

Niels

 

[boomen]

Bekijk bijlage Voorbeeldbestand.xlsm
Bij deze.
Zag dat ik 1 werkblad eruit gehaald had. Daar kwam de Validatie vandaan, excuses.


Edit: De validatie Staat er wel xD. D3 en D5 op eht 3e werkblad.

grtz

 

[Niels28]

Dan zal ik wel een nieuwe bril nodig hebben, in je oude en je nieuwe voorbeeld staat er echt geen valiedatie


Niels

 

[boomen]

Validatie is toch een lijstje maken?
Ik bedoel die vakjes met pijltjes waar ik dan een keuze kan maken in bestrijdingsmiddelen en meststoffen.

Bij mij zijn dat D3 en D5 in het laatste werkblad. Geel gekleurd.

grtz

 

[boomen]

Of ben ik nou gek

 

[Niels28]

Ik zie wel geel gekleurd maar geen pijltjes en geen validatie.


Niels

 

[boomen]

wat moet ik nu dan doen?
bestand anders uploaden??

 

[boomen]

dit is iig de validatie van bestrijdingsmiddelen
=Bewerkingen!$A$5:$A$37
deze is van de mest
=Bewerkingen!$AB$31:$AB$36

 

[Niels28]

ik zie ze niet

maar weet even voldoende

Niels

 

[Niels28]

zie bijlage

Bekijk bijlage Voorbeeldbestand (3).xlsm

Niels

 

[boomen]

:thumb: dit is het.
Mag ik nog vragen wat je nou verändert hebt?
Super bedankt iig man!

grtz