Macro geselecteerde rij verwijderen

[abevleeming]

Ik blijf bezig met Macro vragen en hoewel de titel veel overeenkomt met mijn vorige vraag is deze wel degelijk anders...

Nu eentje waarbij ik een regel wil kunnen verwijderen door middel van een macro (knop regel verwijderen), en dat deze kijkt naar de regels eronder en op basis daarvan automatisch de formules in de onderstaande regel updatet.
Nu heb ik een macro die grotendeels perfect werkt. Wanneer de cel in kolom G gevuld is geeft Excel een macro met een waarschuwing.
Indien deze leeg is kan hij gewoon gaan verwijderen (Sub DeleteRowCategorie) en is het gevolg perfect.

Echter haalt de macro (Sub DeleteRowEis) na de waarschuwing 2 rijen weg in plaats van één.

Ik kan nergens de dubbele rij verwijdering terugvinden dus vroeg me af of iemand het hier wel ziet...

Samenvatting probleem:
Wanneer een waarde in cel van kolom G staat haalt hij twee rijen weg in plaats van één

Samenvatting vraag:
Wat doe ik fout (waardoor er twee regels verwijderen)?

Bekijk bijlage Help mij.xlsm

Sub Regelverwijdering()

Set c = ActiveCell.Offset(, 1 - ActiveCell.Column)
Set d = ActiveCell.Offset(1, 1 - ActiveCell.Column)

val1 = c.Offset(0, 4).Value
val2 = c.Offset(0, 5).Value
val3 = c.Offset(0, 6).Value
val4 = d.Offset(0, 4).Value
val5 = d.Offset(0, 5).Value
val6 = d.Offset(0, 6).Value

If val3 <> "" Then
Application.Run "Warning"
End If
Application.Run "Verwijderen"

End Sub

Sub Verwijderen()

Set c = ActiveCell.Offset(, 1 - ActiveCell.Column)

Set d = ActiveCell.Offset(1, 1 - ActiveCell.Column)

val1 = c.Offset(0, 4).Value
val2 = c.Offset(0, 5).Value
val3 = c.Offset(0, 6).Value
val4 = d.Offset(0, 4).Value
val5 = d.Offset(0, 5).Value
val6 = d.Offset(0, 6).Value

If val4 = "" And val5 = "" And val6 = "" Then
c.Select
Application.Run "DeleteRowEis"
Exit Sub
Else
    If val4 = "" And val5 = "" And val6 <> "" Then
    Application.Run "DeleteRowEis"
    Exit Sub
    Else
        If val4 = "" And val5 <> "" And val6 <> "" Then
        Application.Run "DeleteRowEis"
        Exit Sub
        Else
            If val4 <> "" And val5 <> "" And val6 <> "" Then
            Application.Run "DeleteRowEis"
            Exit Sub
            Else
                If val4 <> "" And val5 <> "" And val6 = "" Then
                Application.Run "DeleteRowCategorie"
                Exit Sub
                Else
                    If val4 <> "" And val5 = "" And val6 = "" Then
                    Application.Run "DeleteRowHoofdstuk"
                    Exit Sub
                    Else
                        If val4 = "" And val5 <> "" And val6 = "" Then
                        Application.Run "DeleteRowCategorie"
                        Exit Sub
                        Else
                            If val4 <> "" And val5 = "" And val6 <> "" Then
                            Application.Run "DeleteRowEis"
                            Exit Sub
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End If

End Sub

Sub DeleteRowEis()

Set c = ActiveCell.Offset(, 1 - ActiveCell.Column)
Set d = ActiveCell.Offset(1, 1 - ActiveCell.Column)

c.Select

Selection.Delete Shift:=xlUp
d.Offset(0, 0).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]<>"""",[@Categorie]="""",[@Eis]=""""),R[-1]C+1,R[-1]C)"
d.Offset(0, 1).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]<>"""",[@Categorie]="""",[@Eis]=""""),0,IF(AND([@Hoofdstuk]="""",[@Categorie]="""",[@Eis]=""""),R[-1]C,IF([@Categorie]=R[-1]C[4],R[-1]C,R[-1]C+1)))"
d.Offset(0, 2).FormulaR1C1 = _
        "=IF(RC[4]="""",0,IF(R[-1]C[4]=RC[4],R[-1]C,R[-1]C+1))"
d.Offset(0, 3).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]="""",[@Categorie]="""",[@Eis]=""""),"""",(CONCATENATE(RC[-3],IF(RC[-2]=0,"""","".""),IF(RC[-2]=0,"""",RC[-2]),IF(RC[-1]=0,"""","".""),IF(RC[-1]=0,"""",RC[-1]))))"
d.Offset(0, 4).FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C)"
d.Offset(0, 5).FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C)"

End Sub

Sub DeleteRowCategorie()

Set c = ActiveCell.Offset(, 1 - ActiveCell.Column)
Set d = ActiveCell.Offset(1, 1 - ActiveCell.Column)

c.Select

Selection.Delete Shift:=xlUp
d.Offset(0, 0).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]<>"""",[@Categorie]="""",[@Eis]=""""),R[-1]C+1,R[-1]C)"
d.Offset(0, 1).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]<>"""",[@Categorie]="""",[@Eis]=""""),0,IF(AND([@Hoofdstuk]="""",[@Categorie]="""",[@Eis]=""""),R[-1]C,IF([@Categorie]=R[-1]C[4],R[-1]C,R[-1]C+1)))"
d.Offset(0, 2).FormulaR1C1 = _
        "=IF(RC[4]="""",0,IF(R[-1]C[4]=RC[4],R[-1]C,R[-1]C+1))"
d.Offset(0, 3).FormulaR1C1 = _
        "=IF(AND([@Hoofdstuk]="""",[@Categorie]="""",[@Eis]=""""),"""",(CONCATENATE(RC[-3],IF(RC[-2]=0,"""","".""),IF(RC[-2]=0,"""",RC[-2]),IF(RC[-1]=0,"""","".""),IF(RC[-1]=0,"""",RC[-1]))))"
d.Offset(0, 4).FormulaR1C1 = "=IF(RC[1]="""","""",R[-1]C)"

d.Offset(0, 5).Select
End Sub

Sub Warning()

Antwoord = MsgBox("Weet je zeker dat je de eis wilt verwijderen?", vbYesNo + vbQuestion)

If Antwoord = vbYes Then
Application.Run "Verwijderen"
Else
    If Antwoord = vbNo Then
    Exit Sub
    End If
End If
Exit Sub
End Sub

 

[abevleeming]

Antwoord heeft zich al geuit!

Door simpelweg alles in 1 macro te knallen in plaats van door sturen in verschillende macro's werkt het echt fantastisch!

En voor degene die denken dat dit veel makkelijker in Access had gekund, jullie hebben gelijk alleen ligt dit ICT technisch zeer gevoelig...:S

 

[sylvester-ponte]

met meerdere macro's werken is vaak eenvoudiger.

en in sub warning staat de regel: Application.Run "Verwijderen"

en in sub Regelverwijdering staat na de aanroep van de sub warning,

de regel: Application.Run "Verwijderen"

dan gebeurt het dus 2 maal

 

[abevleeming]

Danku!