VBA loopt niet door

Status
Niet open voor verdere reacties.

MennoL

Gebruiker
Lid geworden
11 mrt 2015
Berichten
18
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.....
 
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.
 
ipv
Code:
        ActiveWorkbook.Save
        ActiveWindow.Close False

Code:
activeworkbook.close -1
 
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
 
Zonder voorbeeldbestand gaan we niet verder geraken vrees ik.
 
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
 
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.
 
Laatst bewerkt:
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.
 
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.
 
Laatst bewerkt:
Haal die onzinnige 'goto' vervolg er eens uit. En 'select' is helemaal overbodig. Overigens: hij controleert.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan