• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA - error 440

Status
Niet open voor verdere reacties.
anton44

anton44

Verenigingslid
Lid geworden
20 mei 2005
Berichten
1.597
Het script moet een cellenbereik van een tabblad (ImportRB) verplaatsen naar eerste lege regel van een ander tabblad (Bank)
Beperkingen voor het uitvoeren zijn:
1. Geen data in cellenbereik
2. Het aantal rijen in het doelgebied moet groter zijn dan 8

Frequent (8 op 10) komt bij het runnen van een aaneenschakeling van Subs een foutmelding op regel 45
Allerlei pogingen van mij om de oorzaak te vinden stranden helaas.

Het getoonde foutbericht:
FG-2021-08-28_124351.jpg

Een help daarop is als bijlage toegevoegd.

Code: 
Sub RB106_Verplaatsen() 'Overgebleven rijen verplaatsen naar het overzichtswerkblad
 05   Application.ScreenUpdating = False
 10   Dim lLaatsteRij As Long
 15   lLaatsteRij = Sheets("ImportRB").Range("A65536").End(xlUp).Row
 20
 25   If lLaatsteRij >= 8 Then
 30       Sheets("ImportRB").Rows("8:" & lLaatsteRij).Cut 'als A8 op blad Import leeg is alles overslaan
 35       lLaatsteRij = Sheets("Bank").Range("A65536").End(xlUp).Row + 1 'als A8 op blad Bank leeg is, moet lLaatsteRij = 8 worden
 40       lLaatsteRij = -(lLaatsteRij < 6) * 6 - lLaatsteRij * (lLaatsteRij >= 6)
 45       Sheets("Bank").Range("A" & lLaatsteRij).EntireRow.Insert Shift:=xlDown
 50       Application.CutCopyMode = False
 55   End If
 60
 65   Application.GoTo Sheets("Bank").Range("A" & lLaatsteRij), True
 70
 75   Call B06_Dubbelingen_VB
 80
 85   End Sub

Hoewel ik de behoefte voor een voorbeeld onderken kan ik daar helaas niet in voorzien.
 

Bijlagen

  • FG-2021-08-28_130403.jpg
    FG-2021-08-28_130403.jpg
    172,7 KB · Weergaven: 32
Vermoedelijk omdat de laatsteRij op regel 40 soms op 0 uitkomt?
Wanneer hij fout loopt zou ik even checken wat de waarde van die variabele is
 
De laatste rij (= 1e lege rij) is momenteel 365.
 
Uiteraard blijf ik zelf ook zoeken ...
Ik probeer de bewuste bewerking van knippen/plakken van de bron naar het doel handmatig uit te voeren.
Hierbij constateer ik dat de bewerking "geknipte cellen invoegen" niet als optie mogelijk is.
 
Hoewel ik de behoefte voor een voorbeeld onderken kan ik daar helaas niet in voorzien.
Klik om te vergroten...
Waarom niet? Leg dan op zijn minst uit hoe de data in Sheets("ImportRB") in elkaar steekt. De melding in het eerste plaatje lijkt iets te maken te hebben met een dataconnectie. Het berekenen van de laatste rij in het blad 'bank' steekt ook wat ingewikkeld in elkaar. Maar dat is de vraag niet.
 
Ik heb allerlei pogingen ondernomen om een afgemagerd en ongevoelig voorbeeld te destilleren maar tot nu toe niet werkend ???
Omschrijven hoe sheets("ImportRB"_ in elkaar steekt daar weet ik geen raad mee om dat duidelijk over te brengen.
Het script gerelateerd regelt:
1. Importeren van een .csv bestand als .txt met mutaties van de bank.
2. Kolomschikking
3. Filtering van te oude posten
4. Formules kopiëren en cellen opmaken
5. Verplaatsen van overgebleven rijen naar het verzamelblad "Bank"
 
De veroorzaker LIJKT gevonden te zijn in de voorlopende sub om de rijen te verwijderen in "ImportRB" die ouder zijn dan een gekozen datum.
De te kiezen datum is afhankelijk van de waarde in "D9" of "D10"

sub met fout resultaat:
Code: 
Sub RB104_Filter()  'mutaties voor ingestelde datum
 Application.ScreenUpdating = False
   With Sheets("Variabelen")
      TempnameA = .Range("D9") '= NL14000000
      TempnameB = .Range("E9") '= NL03000000
   End With
   With Sheets("importRB")
       Set c1 = .Range("A7:A" & Application.Max(8, .Range("A" & Rows.Count).End(xlUp).Row)).Resize(, 38) 'rij 7=koprij en 40 kolommen
      Select Case c1.Cells(2, 1).Value              '
         Case TempnameA
            With c1
               .AutoFilter 4, "<" & Format(Sheets("Variabelen").Cells(3, 7), "m-d-yyyy")
               .Offset(1).EntireRow.Delete
               .AutoFilter
            End With
         Case TempnameB
            With c1
               .AutoFilter 4, "<" & Format(Sheets("Variabelen").Cells(4, 7), "m-d-yyyy")
               .Offset(1).EntireRow.Delete
               .AutoFilter
            End With
      End Select
   End With
   Application.ScreenUpdating = True
 Call RB105_Formules_kopiëren

Vervangen door:
Code: 
Sub RB104_Filter()  'mutaties voor ingestelde datum 
 Application.ScreenUpdating = False
    With Sheets("importRB").Cells(7, 1).CurrentRegion
       .AutoFilter 4, "<" & Format(Sheets("Variabelen").Cells(3, 7), "m-d-yyyy")
       .Offset(1).EntireRow.Delete
       .AutoFilter
    End With
   Application.ScreenUpdating = True
   Call RB105_Formules_kopiëren
End Sub

De selectie van datum kan ik op een andere manier regelen tenzij de code in de oude sub aangepast kan worden.

Helaas, helaas.
Na vele malen getest zonder problemen toch weer de error :)
 
Laatst bewerkt:
Aangezien het probleem zich niet 100% manifesteerde ben ik elders blijven zoeken. Hierbij ging de gedachte naar de extra klembordmanager (Ditto) die ik al jaren gebruik voor het meervoudig kopiëren. Deze heb ik als proef verwijderd en mijn excel-VBA bewerkingen veelvuldig gedraaid.
De foutmelding heeft zich niet meer gemanifesteerd !
Mogelijk is door recente updates van Windows 10 (meervoudig kopiëren/plakken ?) en/of Excel updates een geheugenconflict ingeslopen en zou dat de oorzaak kunnen zijn van mijn probleem.
 
Als we niet kunnen over je schouder meekijken en als het probleem zich sporadisch voordoet, dan blijft alles puur gokken.
Als het probleem ligt bij het verwijderen van rijen ouder dan een bepaalde datum en je daarop volgend, het probleem oplost met een andere klembordmanager, dan ben ik helemaal het noorden kwijt.
Op welke regel gaat het eigenlijk nu nog sporadisch fout met je 440, of is het ondertussen een andere ?

Jouw voorgestelde probleem zou eigenlijk in enkele regels op te lossen zijn, mogelijks met tabellen maar aangezien je nog van 65.000 rijen praat, zit je nog met een excel2003?
 
Mijn Excel versie is 2019
De fout werd gemeld op regel 45
Code: 
45   Sheets("Bank").Range("A" & lLaatsteRij).EntireRow.Insert Shift:=xlDown
De import zal nooit meer zijn dan 50 regels ("RBImport") en het verzamelbestand ("Bank") zal op het eind van het jaar max 1000 regels zijn.
Nu ik de externe klembordmanager verwijderd heb heeft het probleem zich niet meer voorgedaan.
 
ik ben te weinig onderlegd om mij aan een zinnige uitspraak over een klembordmanager te wagen.

Code: 
   With Sheets("Bank")                                          'jwe werkblad
      '.Range("B" & Rows.Count).Value = "test"
      lLaatsteRij = Application.Max(6, .Range("A" & Rows.Count).End(xlUp).Row + 1)   'laatste rij (voor alle excel-versies) met minimum 6
      If lLaatsteRij > 1000 Then MsgBox "toch veel rijen dit jaar !!!" & vbLf & lLaatsteRij, vbExclamation
      .Rows(lLaatsteRij).Insert Shift:=xlDown                   'op die rij een rij tussenvoegen
   End With
bovenstaande code doet net hetzelfde als de jouwe, ondergrens 6, waarschuwing bij bovengrens 1.000.
Als er nu per toeval iets in de laatste rij zou staan, dan kan je geen rij tussenvoegen en ga je in de fout (haal het enkel aanhalingsteken weg vooraan de 2e regel).
Wat er hier gebeurt, is verder zo basic, dat ik me niet kan voorstellen dat er iets mis kan gaan. (tenzij je nu zegt dat je ook met samengevoegde cellen of zo werkt)
 
Laatst bewerkt:
Bedankt voor je reactie.
Er zijn geen samengevoegde cellen in het invoegbereik.
Je voorgestelde code geeft een foutmelding zie ook bijlage

Code: 
Sub RB106_Verplaatsen() 'Overgebleven rijen verplaatsen naar het overzichtswerkblad
    Application.ScreenUpdating = False
    
    Dim lLaatsteRij As Long
    lLaatsteRij = Sheets("ImportRB").Range("A200").End(xlUp).Row
 
    With Sheets("Bank")                     'jwe werkblad
      .Range("B" & Rows.Count).Value = "test"
      lLaatsteRij = Application.Max(6, .Range("A" & Rows.Count).End(xlUp).Row + 1)   'laatste rij (voor alle excel-versies) met minimum 6
      If lLaatsteRij > 1000 Then MsgBox "toch veel rijen dit jaar !!!" & vbLf & lLaatsteRij, vbExclamation
      .Rows(lLaatsteRij).Insert Shift:=xlDown        'op die rij een rij tussenvoegen
   End With

    Application.GoTo Sheets("Bank").Range("A" & lLaatsteRij), True
 
    Call B06_Dubbelingen_VB
 
End Sub
 

Bijlagen

  • FG-2021-09-06_133829.jpg
    FG-2021-09-06_133829.jpg
    146,1 KB · Weergaven: 16
1. moet je laatste rij in "importRB" of in "Bank" gezocht worden, want in bovenstaande zoek je eerst de laatste gevulde cel vanaf A200 omhoog en daarna in de with ... end with constructie de eerstvolgende lege A-cel in "Bank", dus 2 verschillende werkbladen en 2 verschillende te zoeken cellen.

2. ik had willen waarschuwen voor mogelijkse problemen na verloop van tijd.
Je zoekt de eerste volgende lege cel in de A-kolom, maar daarom kan er in een andere kolom op een veel hogere rijnummer nog iets staan.
In mijn meegestuurde voorbeeld maakte ik heel opzettelijk die fout, door in de allerlaatste rij in de B-kolom "test" te schrijven en dan te pogen een rij tussen te schuiven, wat logischerwijs tot een fout leidt met deze melding. Gooi die regel weg, maak die laatste B-cel leeg en probeer het nog een keer.
 

Bijlagen

  • Schermafbeelding 2021-09-06 142909.png
    Schermafbeelding 2021-09-06 142909.png
    17 KB · Weergaven: 14
De geïmporteerde rijen in "RBImport" van rij 8 tm ... moeten verplaatst worden naar de 1e lege rij (kolom A) in "Bank"
De 1e lege rij kolom A in "Bank" zijn alle cellen leeg.
Het verwijderen van .Range("B" & Rows.Count).Value = "test" geeft geen verbetering - foutmelding blijft.

(je hebt er blijkbaar zin in :thumb: )
 
heb je ook "test" verwijderd in cel B1048576 ? (de laatste B-cel)
Je krijgt toch die foutmelding die ik gaf in #13 ?
Dus ...
 
Oeps. Niet gezien/geweten.
Kreeg id de foutmelding zoals #13
Nu tekst verwijderd. Geen foutmelding meer.
Er wordt 1 regel toegevoegd met alleen de opmaak van de regel - geen data hoewel er 12 gevulde regels in "RBImport" klaar staan om verplaatst te worden naar "Bank".
 
Dat is het als je zomaar in het ijle zit te praten, een voorbeeldbestand doet alles.
Met de macro "NieuweGegevens_aanmaken" maak je een bereik van zoveel rijen bij 12 kolommen aan, analoog als wat jij als csv inlees.
Met de macro "NieuweGegevens_Doorkopieren" zet je ze onderaan in "Bank" erbij en wis je ze in "ImportRB"

Veel moeilijker kan het toch niet zijn.
 

Bijlagen

  • Anton.xlsm
    37,1 KB · Weergaven: 12
Bedankt voor je vele werk.
Alhoewel ik de codes niet kan doorgronden (gebrek aan kennis van mijn kant) toch een poging gedaan
met Sub NieuweGegevens_Doorkopieren()
Het resultaat is dat de gegevens van "RBImport" niet ingevoegd worden vanaf de 1e lege rij in "Bank" maar gekopieerd. De formules, opmaak worden niet meegenomen.

Ik ben al een hele tijd bezig geweest een representatief voorbeeldbestand in elkaar te draaien maar slaag daar niet in.

Aangezien ik niet de kennis heb je aangedragen principes aan te passen voor mijn situatie stel ik voor hier niet mee door te gaan.

Ik ben je zeer dankbaar voor de nieuwe uitdagingen.
 
ik begrijp niet het invoegen, is het in een tabel met onderaan een totaal of zo ?

Deze knipt en plakt door het rode deel (zonder invoegen)

Code: 
Sub NieuweGegevens_Doorkopieren()
   With Sheets("ImportRB")                                      'hier staan je nieuwe gegevens
      Set c0 = .Range("A8")                                     '--> je eerste cel met gegevens
      If Len(c0.Value) = 0 Then MsgBox "foutje bedankt": Exit Sub   'er er daar al niets staat, dan is het een foute boel
      With c0.CurrentRegion                                     'bereik rond die cel
         Set c1 = .Offset(8 - .Row).Resize(.Rows.Count - 8 + .Row, 12)   'vanaf je startcel zoveel rijen en 12 kolommen = bereik dat je straks wegschrijft naar "Bank"
      End With
      MsgBox "door te kopieren gegevens staan in " & c1.Address
   End With

   With Sheets("Bank")
      Set c2 = .Range("A" & Rows.Count).End(xlUp).Offset(1)     'eerste volgende lege A-cel
      If c2.Row < 6 Then Set c2 = .Range("A6")                  'minimaal vanaf A6
      If c2.Row > 1000 Then MsgBox "toch veel rijen dit jaar !!!" & vbLf & c2.Row, vbExclamation   'test op aantal rijen
   End With

  [COLOR="#FF0000"][SIZE=3] c1.Cut c2[/SIZE][/COLOR]

End Sub
 
Laatst bewerkt:
nu ook met tussenvoegen, enkel nog het aantal kolommen bovenin aanpassen naar jouw situatie
Code: 
Sub NieuweGegevens_Doorkopieren()
   kolommen = 12                                                '<------------------hoeveel kolommen wens je mee te nemen ???? nu 12, aanpassen !!!

   With Sheets("ImportRB")                                      'hier staan je nieuwe gegevens
      Set c0 = .Range("A8")                                     '--> je eerste cel met gegevens
      If Len(c0.Value) = 0 Then MsgBox "foutje bedankt": Exit Sub   'er er daar al niets staat, dan is het een foute boel
      With c0.CurrentRegion                                     'bereik rond die cel
         Set c1 = .Offset(8 - .Row).Resize(.Rows.Count - 8 + .Row, kolommen)   'vanaf je startcel zoveel rijen en 12 kolommen = bereik dat je straks wegschrijft naar "Bank"
      End With
      MsgBox "door te kopieren gegevens staan in " & c1.Address
   End With

   With Sheets("Bank")
      Set c2 = .Range("A" & Rows.Count).End(xlUp).Offset(1)     'eerste volgende lege A-cel
      If c2.Row < 6 Then Set c2 = .Range("A6")                  'minimaal vanaf A6
      If c2.Row > 1000 Then MsgBox "toch veel rijen dit jaar !!!" & vbLf & c2.Row, vbExclamation   'test op aantal rijen
   End With

   With c2.Offset(-1)                                           'cel boven bereik waar je invoegt
      .Offset(1).Resize(c1.Rows.Count, kolommen).Insert xlDown  'zoveel lege rijen tussenvoegen als nodig
      c1.Cut .Offset(1)                                         'knippen en plakken in het nieuwe deel
   End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan