VBA loopt niet door

MennoL · 13 apr 2016

Hoi,

Ik heb een probleem met een VBA code. Als ik cel S4 geen "aanpassen" staat dan gaat de VBA niet verder naar de volgende "if". Waarschijnlijk vergeet ik iets toe te voegen als "go to next" of zo? Iemand die toevallig zo het probleem weet?

Wat mij ook niet lukt is om bij ActiveCell.Formula = "=SUM(C6)-(C79+D79+E79+F79+G79+H79+I79+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))" te verwijzen naar een cel waar de formule instaat zoals (Sheets("Bestand").Range("C4").Value). Is dit simpel op te lossen?

De "'Selection.AutoFill Destination:=Range("W38:W55")" is bewust, omdat voor deze toepassing het doortrekken van de formule niet nodig is.

Alvast bedankt.

HTML:

Sub Opslaan08()

On Error GoTo EH


    ActiveSheet.Unprotect Password:=""
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False


'formule moet engels zijn!
If Sheets("Bestand").Range("S4").Value = "Aanpassen" Then
Workbooks.Open Filename:=(Sheets("Formule").Range("AD4").Value), UpdateLinks:=0
End If
If ActiveWorkbook.ReadOnly = False Then
Sheets("F").Visible = True
ActiveSheet.Unprotect Password:=""
Sheets("F").Select
Range("W38").Select
ActiveCell.Formula = "=SUM(C6)-(C79+D79+E79+F79+G79+H79+I79+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))"
'Selection.AutoFill Destination:=Range("W38:W55")
ActiveWindow.SelectedSheets.Visible = False
ActiveWorkbook.Save
ActiveWindow.Close False
Sheets("Bestand").Range("S4").Value = "Klaar"
Else
ActiveWindow.Close False
End If
If Sheets("Bestand").Range("S5").Value = "Aanpassen" Then
Workbooks.Open Filename:=(Sheets("Formule").Range("AD5").Value), UpdateLinks:=0
End If
If ActiveWorkbook.ReadOnly = False Then
Sheets("F").Visible = True
ActiveSheet.Unprotect Password:=""
Sheets("F").Select
Range("W38").Select
ActiveCell.Formula = "=SUM(C6)-(C79+D79+E79+F79+G79+H79+I79+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))"
'Selection.AutoFill Destination:=Range("W38:W55")
ActiveWindow.SelectedSheets.Visible = False
ActiveWorkbook.Save
ActiveWindow.Close False
Sheets("Bestand").Range("S5").Value = "Klaar"
Else
ActiveWindow.Close False
End If


etc.....

Warme bakkertje · 13 apr 2016

Zal eerder zoiets worden.

Code:

Sub Opslaan08()
 
On Error GoTo EH
 
 
    ActiveSheet.Unprotect Password:=""
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
 
 
'formule moet engels zijn!
For iRow = 4 To Sheets("Bestand").Range("S" & Rows.Count).End(xlUp).Row
    If Sheets("Bestand").Range("S" & iRow).Value = "Aanpassen" Then
        Workbooks.Open Filename:=(Sheets("Formule").Range("AD" & iRow).Value), UpdateLinks:=0
    End If
    If ActiveWorkbook.ReadOnly = False Then
        With Sheets("F")
            .Visible = True
            .Unprotect Password:=""
            .Range("W38").Formula = "=SUM(C6)-(SUM(C79:I79)+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))"
            .Protect Password:=""
            .Visible = False
        End With
        'Selection.AutoFill Destination:=Range("W38:W55")
        ActiveWorkbook.Save
        ActiveWindow.Close False
        Sheets("Bestand").Range("S" & iRow).Value = "Klaar"
    Else
        ActiveWindow.Close False
    End If
Next
EH:
    ActiveSheet.Protect Password:=""
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub

Wat betreft de formule kan je deze best eens een keer opnemen met de macrorecorder en kijken wat eruit komt.

snb · 13 apr 2016

ipv

Code:

        ActiveWorkbook.Save
        ActiveWindow.Close False

Code:

activeworkbook.close -1

MennoL · 13 apr 2016

Bedankt voor jullie reacties. Ik ga het uit proberen.

MennoL · 13 apr 2016

Heb nu onderstaande staan, maar hij gaat niet naar S5. Als er in S4 "Klaar" staat en in S5 "Aanpassen", dan gaat hij ook niet verder. Als in S4 "Aanpassen" staat dan doet hij dus alleen S4
Het loopt uiteindelijk tot Bestand S29 en Formule AD29.

(Sheet weer protecten is niet nodig)

Wat doe ik fout?

Code:

Sub Opslaan08()

On Error GoTo EH

    Application.ScreenUpdating = False


'formule moet engels zijn!
For iRow = 4 To Sheets("Bestand").Range("S" & Rows.Count).End(xlUp).Row
    If Sheets("Bestand").Range("S" & iRow).Value = "Aanpassen" Then
        Workbooks.Open Filename:=(Sheets("Formule").Range("AD" & iRow).Value), UpdateLinks:=0
    End If
    If ActiveWorkbook.ReadOnly = False Then
        With Sheets("F")
            .Visible = True
            .Unprotect Password:=""
            .Range("C10").Formula = "=SUM(C6)-(SUM(C79:I79)+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))"
            .Visible = False
        End With
        'Selection.AutoFill Destination:=Range("W38:W55")
        ActiveWindow.Close -1
        Sheets("Bestand").Range("S" & iRow).Value = "Klaar"
    Else
        ActiveWindow.Close False
    End If

Next


EH:

Application.ScreenUpdating = True

End Sub

Warme bakkertje · 13 apr 2016

Zonder voorbeeldbestand gaan we niet verder geraken vrees ik.

MennoL · 14 apr 2016

Hierbij een aangepast voorbeeld.

Alvast bedankt voor je hulp.

Warme bakkertje · 14 apr 2016

Code:

Sub Opslaan08()
On Error GoTo EH
Application.ScreenUpdating = False
For iRow = 4 To Sheets("Bestand").Range("E" & Rows.Count).End(xlUp).Row
    If Sheets("Bestand").Range("E" & iRow).Value = "Aanpassen" Then             'Als "waar" dan
        Workbooks.Open Filename:=(Sheets("Formule").Range("C" & iRow).Value), UpdateLinks:=0 'Workbook openen in cel
    Else: GoTo vervolg
    End If
    If ActiveWorkbook.ReadOnly = False Then             'Als bestand niet al geopend is.
        With Sheets("F")
            .Visible = True                        'Sheet weergeven
            .Unprotect Password:=""             'Eventueel wachtwoord er af halen (hoeft er niet opnieuw op).
            .Range("C10").Formula = "=SUM(C6)-(SUM(C79:I79)+(L79*Admin!K41)+(N79*Admin!K42)+M79+O79+(P79*Admin!M41))"  'Welke formule moet er ingevuld worden (Engels!).
            .Visible = False                        'Sheet verbergen
        End With
        ActiveWindow.Close -1                       'Opslaan en afsluiten
        Sheets("Bestand").Range("E" & iRow).Value = "Klaar"             'Van "Aanpassen" naar "Klaar" indien succesvol.
    Else
        ActiveWindow.Close False
    End If
vervolg:
Next
EH:
Application.ScreenUpdating = True
End Sub

snb · 14 apr 2016

Code:

Sub M_snb()
   sn = Columns(4).SpecialCells(2).Resize(, 2)
   
   For j = 1 To UBound(sn)
     If sn(j, 2) = "aanpassen" Then
         With GetObject("L:\Rapportages\Tool\Cluster08\" & sn(j, 1) & ".xlsx")
           .Sheets("F").Cells(10, 3) = "=C6-SUM(C79:I79;L79*Admin!K41;N79*Admin!K42;M79;O79;P79*Admin!M41)"
           .Close -1
         End With
         sn(j, 2) = "klaar"
     End If
   Next
   
   Columns(4).SpecialCells(2).Resize(, 2) = sn
End Sub

Vermijd goto konstrukties.
Verdiep je eens in de logica van If ...end if ; if ... else ... end if; if ... elseif ...elseif ... else ... end if

Sum(c6) is natuurlijk onzin.
Sum(A1+A2) natuurlijk ook.

MennoL · 14 apr 2016

Heb voor warme bakkertje gekozen, omdat die constructive duidelijker is voor mij en eventuele toekomstige gebruikers. Heb er wel stukken van SNB aan toe kunnen voegen. :thumb:

Beide super bedankt! Weer iets bijgeleerd en maakt het aanpassen nu een stuk makkelijker.

MennoL · 14 apr 2016

Zie trouwens dat het stukje "'Selection.AutoFill Destination:=Range("W38:W55")" helaas niet werkt. Voor een andere variant had ik die nu wel nodig. Heb verschillende opties geprobeerd, maar kom er niet uit. Alles wat ik kan terug vinden via Google werkt niet.

Laatste optie was nog om hem uit de "With" te halen, maar ook dat werkt niet.

Code:

For iRow = 4 To Sheets("Bestand").Range("I" & Rows.Count).End(xlUp).Row
    If Sheets("Bestand").Range("I" & iRow).Value = "Aanpassen" And Dir(Sheets("Formule").Range("I" & iRow).Value) <> "" Then             
        Workbooks.Open Filename:=(Sheets("Formule").Range("I" & iRow).Value), UpdateLinks:=0 
    Else: GoTo vervolg
    End If
    If ActiveWorkbook.ReadOnly = False Then     
        With Sheets("Heads Up")                        
            .Visible = True                     
            .Unprotect Password:=""             
           
        End With
    Range("X45").Select
    Selection.AutoFill Destination:=Range("X45:X63"), Type:=xlFillDefault
    ActiveWindow.Close -1
    Sheets("Bestand").Range("I" & iRow).Value = "Klaar"             
    Else
        ActiveWindow.Close False
    End If
vervolg:
Next

Heb er ook nog aan toegevoegd dat hij naast "Aanpassen" ook controleert of het bestand bestaat.

snb · 14 apr 2016

Haal die onzinnige 'goto' vervolg er eens uit. En 'select' is helemaal overbodig. Overigens: hij controleert.

MennoL · 14 apr 2016

snb zei:
Haal die onzinnige 'goto' vervolg er eens uit. En 'select' is helemaal overbodig. Overigens: hij controleert.

Heeft helaas niet geholpen. Hij blijft hangen op het autofill verhaal.

VBA loopt niet door

MennoL

Gebruiker

Warme bakkertje

Meubilair

snb

Verenigingslid

MennoL

Gebruiker

MennoL

Gebruiker

Warme bakkertje

Meubilair

MennoL

Gebruiker

Bijlagen

Warme bakkertje

Meubilair

snb

Verenigingslid

MennoL

Gebruiker

MennoL

Gebruiker

snb

Verenigingslid

MennoL

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy