data naar ander bestand loopt niet door, en extra vraag

[HBot]

Best Forum,

probleem;
na lang zoeken en puzzelen heb ik de code gevonden en aangepast om gegevens te kopiëren naar een ander bestand,
dit werkt(e) goed op mijn eigen PC, maar loopt vast op laptop werk,
doel bestand opent netjes maar op het moment van kopiëren loopt het vast in deze regel
> Workbooks("Overview Complaints").Sheets("Overview Complaint").Range("A" & Rows.Count).End(xlUp).Row
waar ga ik de fout in.

2e vraag; dit "invulblad4" (wordt een document) dat meerdere keren gewijzigd kan worden, hoe kan ik als er een bestaand document gewijzigd wordt de al bestaande "volgnummer" in [kolom A:A] overschrijven ipv onder aan te sluiten.

Sub macro1()
Dim i As Long
Dim wb As Workbook
Dim pad, lnk, naam As String

pad = "S:\Projecten\OFO\OFO Zwolle 2020+\1 OFO in Behandeling"
lnk = "S:\Projecten\OFO\OFO Zwolle 2020+\1 OFO in Behandeling"

Application.ScreenUpdating = False

    On Error Resume Next
    Set wb = Workbooks("Overview Complaints.xlsm")
    On Error GoTo 0
    
    If wb Is Nothing Then
        Set wb = Workbooks.Open("S:\Projecten\OFO\Masterdata OFO\Opzet nieuwe OFO Form\Test\Overview Complaints.xlsm")
    Else
    End If
'Workbooks("invulblad4.xlsm").Sheets("melding").Select
Workbooks("invulblad4.xlsm").Sheets("melding").Activate
Workbooks("Overview Complaints").Sheets("Overview Complaint").Range("A" & Rows.Count).End(xlUp).Row

Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 1) = Sheets("melding").Range("volgnummer").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 2) = Sheets("melding").Range("datum").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 3) = Sheets("melding").Range("bedrijf").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 4) = Sheets("melding").Range("contact").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 5) = Sheets("melding").Range("telefoon").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 6) = Sheets("melding").Range("onderwerp").Value
Workbooks("Overview Complaints").Sheets("Overview Complaint").Cells(i + 1, 7) = Sheets("melding").Range("omschrijving").Value


Application.ScreenUpdating = True
Workbooks("Overview Complaints").Close SaveChanges:=True

ActiveWorkbook.SaveAs pad & "\" & Sheets("melding").Range("b1") & ".xlsm", FileFormat:=52
End Sub

bijgevoegd beide bestanden.

 

[VenA]

Ik begrijp niet zo heel veel van de code. Moet de eerste regels steeds overschreven worden? De variabele i krijgt nergens een waarde.

Voor het overzetten van de gegevens van het ene naar het ander bestand is dit voldoende. Wel even het pad aanpassen.

Sub VenA()
  Dim ar
  With Sheets("melding")
    ar = Array(.Range("volgnummer").Value, .Range("datum").Value, .Range("bedrijf").Value, .Range("contact").Value, .Range("telefoon").Value, .Range("onderwerp").Value, .Range("omschrijving").Value)
  End With
  
  With GetObject("[COLOR="#FF0000"]E:\Temp\[/COLOR]Overview Complaints.xlsm")
    .Sheets("Overview Complaint").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = ar
    .Close True
  End With
End Sub

 

[HBot]

VenA,

Perfect, dit werkt, en een mooie korte code ook,

maar wat ik bedoel, als iemand iets in bestand 24417-009 veranderd en deze gegevens overbrengt naar het overzicht dan gebeurd dit onder hetzelfde nummer maar komt onderaan de lijst te te staan, hierdoor 2 regels met hetzelfde document nummer, ik zou graag zien dat de gegevens in de al bestaande regel 24417-009 wordt overschreven.

 

[VenA]

De volgnummers zijn datums die je op een zeer bijzondere manier hebt opgemaakt. Dus daar zal je eerst wat aan moeten doen.

 

[HBot]

VenA

al deze cellen omgezet naar getallen.

Worden netjes onder elkaar gezet, bestaande code nog niet overschreven.

nog een vraagje, in het doel bestand is de sheet niet zichtbaar, via beeld zichtbaar maken wel, kan dit in de code opgenomen worden.

 

[VenA]

Dat is inderdaad een beetje rare eigenschap van GetObject.

Zet in de module van Thisworkbook van het bestand Overview Complaints.xlsm het volgende:

Private Sub Workbook_Open()
  Windows("Overview Complaints.xlsm").Visible = True
End Sub

 

[HBot]

VenA

Bedankt, alles blijft zichtbaar.

blijkt nu nog het stukje over,

hoe overschrijf ik de data als het volgnummer in kolom A:A al bestaat.

 

[VenA]

With GetObject("E:\Temp\Overview Complaints.xlsm").Sheets("Overview Complaint")
    r = Application.Match(ar(0), .Columns(1), 0)
    If IsNumeric(r) Then .Cells(r, 1).Resize(, 7) = ar Else .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 7) = ar
    .Parent.Close True
  End With

 

[HBot]

VenA

Ben de codes om aan het zetten vanuit de test bestandjes en aan te passen waar nodig.
het gaat om meerdere cellen die ik allemaal een naam hebt gegeven voor de duidelijkheid.(en als ik nog iets wil schuiven op het tabblad blijft de code intact)
aantal cellen heb ik aangepast in de resize van 7 naar 19.
de te vullen cellen beginnen in kolom 3 (aangepast)(de eerste 2 staat een berekening op week en periode niveau.
alle informatie wordt vanuit nieuwe bestandjes netjes gekopieerd en onderaan gezet
so far so good.

Bij het overschrijven gaat het nog fout, deze wordt onderaan gezet

ik denk?? dat het te maken heeft met;
If isNumeric(r), de nummering die ik gebruikt wordt gecreëerd door samenvoegen 2 cellen (getallen + tekst)
de eerste kolom (cel) van het bronbestand is de datum deze wordt naar het doel bestand gekopieerd in kolom (3) en niet de nummering-code die staat als 2e in het bronbestand en komt in het doelbestand in kolom (4)

is dit te fiksen anders moet ik zowel bron als doel bestand ombouwen.
hieronder de nieuwe code.

Sub DATA_Overzetten()
'data overzetten naar klachtenoverzicht, overzicht opslaan en sluiten
  Dim ar
   
  With Sheets("DATA overzetten")
    ar = Array(.Range("Datum").Value, .Range("Document").Value, .Range("Debiteurnr").Value, .Range("Klant").Value, .Range("Artikelnr").Value, .Range("Product").Value, .Range("Klacht").Value, .Range("KLachtCAT").Value, .Range("Coördinator").Value, .Range("Filter1").Value, .Range("Filter2").Value, .Range("Filter3").Value, .Range("Rayon").Value, .Range("Profit").Value, .Range("Contact").Value, .Range("PRodsite").Value, .Range("CoördinatorSite").Value, .Range("Class").Value, .Range("Veroorzaakafd").Value)
  End With
  
  With GetObject("S:\Projecten\Klachten\Nieuwe Klachten procedure 2020\Klachtenoverzicht.xlsm").Sheets("Klachten overzicht")
  r = Application.Match(ar(0), .Columns(4), 0)
    If IsNumeric(r) Then .Cells(r, 1).Resize(, 19) = ar Else .Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, 19) = ar
    .Parent.Close True
  End With
  
End Sub

 

[VenA]

Als je iets denkt dan kan je ook de code even debuggen om te kijken waar het fout gaat. Het basisprincipe heb je nu.

 

[HBot]

weer iets geleerd,

geeft melding bij;
>If Isnumeric (r) then
geeft een Fout 2042 Variant/error

nu gaat mijn kennis nog niet zover om te weten wat het betekend of hoe op te lossen, kan ook niet zo snel iets op het net vinden,
bijgaand printscreen

 

[VenA]

Daar zal de de fout niet gegeven worden. If Isnumeric (r) then toetst of het een getal is en dat is in dit geval dus niet zo. Je zal het moet zoeken in de Application.match want die kan het blijkbaar niet vinden en ik ben niet helderziend.

 

[HBot]

Jammer, :d

Niet dat ik het helemaal begrijp, maar het lijkt erop hij niet kijkt (of kan vinden) in kolom 4 naar een vergelijkbaar nummer,
ik weet ook niet of ie wel een vergelijk vindt deze data dan vanaf kolom 3 vervangt.
weet nu waar het probleem zich voordoet maar kan geen oplossing vinden.

Heb even een test gedaan;
eerste 2 kolommen verwijdert, (zijn wel nodig omdat hierop geselecteerd wordt welke periode)
kolom 4 (volgnummer) als eerste neergezet
kolom 2 is de datum.

op deze manier werkt het wel.

als ik geen oplossing kan vinden is het dan mogelijk om de eerste 2 kolommen te vullen en dan vervolgens vanaf kolom 5 verder te gaan
dan moet ik het bestand ombouwen naar de nieuwe optie

 

[VenA]

Mij lijkt het bestand plaatsen een betere oplossing. Uit het verhaal kan ik niet opmaken wat je allemaal aan het doen bent.

 

[AD1957]

probeer het eens in deze richting

Set r = .Columns(4).Find(ar(0), , , xlWhole)

       If r Is Nothing Then
         'jouw code
       Else
         'jouw code
       End If

En anders zoals VenA vraagt, plaats een goed gelijkend voorbeeldbestand.

 

[HBot]

je hebt gelijk,

soms is het (te) makkelijk om het probleem bestand op te sturen, en aangepast terug te krijgen, maar dan leer je niet zo veel, vandaag vermoeiende dag maar leerzaam
zal morgen een voorbeeldbestand maken, of de test bestandjes aanpassen.

in het originele zit te veel bedrijfs-gevoelige informatie in.

Albert ga dan ook even jouw code proberen.
voor nu oogjes toe.

 

[VenA]

Het heeft geen nut om de code van @AD1957 te proberen. (Doet hetzelfde maar is alleen wat omslachtiger en trager.)

 

[cow18]

bovenin je module staat "Option explicit", vermoedelijk heb je dan daarna r gedeclareerd als integer of long.
Dat had je niet mogen doen of toch tenminste r te declareren als variant.
Daardoor treedt die fout op.
Probeer anders eens door en "option explicit" te verwijderen en r niet meer de declareren of anders gewoon Dim r zonder te zeggen long of integer.

 

[HBot]

Goedemorgen

hierbij de nieuwe test bestandjes,
hopelijk maak dit het duidelijk en is de oplossing nabij.

in het overzicht zie je 2 x klacht 6 en klacht 7 terug komen, de bedoeling is dat als de bron 6 of 7 wordt aangepast dat de oude gegevens worden overschreven en niet als nieuwe worden toegevoegd, code staat in kolom 4, kolommen 1-3 graag intact houden.
Verder werkt de code perfect.:thumb:

Sub DATA_Overzetten()
'data overzetten naar klachtenoverzicht, overzicht opslaan en sluiten
  Dim ar
  Dim r
   
  With Sheets("DATA overzetten")
    ar = Array(.Range("Datum").Value, .Range("Document").Value, .Range("Debiteurnr").Value, .Range("Klant").Value, .Range("Artikelnr").Value, .Range("Product").Value, .Range("Klacht").Value, .Range("KLachtCAT").Value, .Range("Coördinator").Value, .Range("Filter1").Value, .Range("Filter2").Value, .Range("Filter3").Value, .Range("Rayon").Value, .Range("Profit").Value, .Range("Contact").Value, .Range("PRodsite").Value, .Range("CoördinatorSite").Value, .Range("Class").Value, .Range("Veroorzaakafd").Value)
  End With
  
  With GetObject("S:\Projecten\Klachten\Nieuwe Klachten procedure 2020\Klachtenoverzicht test.xlsm").Sheets("Klachten overzicht")
  r = Application.Match(ar(0), .Columns(4), 0)
    If IsNumeric(r) Then .Cells(r, 1).Resize(, 19) = ar Else .Cells(Rows.Count, 3).End(xlUp).Offset(1).Resize(, 19) = ar
    .Parent.Close True
  End With
  
End Sub

 

[AD1957]

Probeer het eens zo...
r = Application.Match(ar(1), .Columns(4), 0)