Afschrijving macro

[Marky76]

Wigi,
Ik heb blijkbaar toch nog een probleem met de macro. Heb hem op het werk laten runnen, maar hij werkte niet helemaal, met als gevolg dat ik toch alles manueel heb moeten doen, er zouden nog enkele aanpassingen aan de macro moeten komen die ik niet voor mekaar krijg.

Groeten,
Mark

 

[Marky76]

Het probleem op rij 22 en 23 heb ik gevonden, er zat een dom sommetje in waardoor de macro de lijn oversloeg. Met de rest sukkel ik nog.

 

[Marky76]

Mag dit 2 x AND gebruiken?

If Cells(iSRij, "K").HasFormula = False And Cells(iSRij, "L").Value < 1 And Cells(iSRij, "M") <> "" Then

 

[Wigi]

Dat kan inderdaad zo.

 

[Marky76]

Wigi,

Zo ziet de macro er nu uit, want er waren nog wat problemen.

Sub Afschrijving()
Dim iSRij As Integer, iRij As Integer

Application.StatusBar = "Ik ben bezig - even geduld."

If MsgBox("Eerst met ASAP nagaan of er in kolom G & H & J en L geen formules zijn, enkel die kolommen selecteren met ASAP", _
vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then

MsgBox ("Nagaan dat alle subtotalen als bereik één cel boven het laatste getal hebben")
MsgBox ("Anders gaat de macro crashen want de formule verwijst dan naar een cel die gewist is geweest")

    iRij = Range("A65536").End(xlUp).Row
    For iSRij = iRij To 4 Step -1
        
       
      If Cells(iSRij, "J").HasFormula = False And Cells(iSRij, "M") <> "" Then
      Cells(iSRij, "J").Value = Cells(iSRij, "M").Value
      End If
         
If Cells(iSRij, "H").HasFormula = False And Cells(iSRij, "H").Value >= 1 And Cells(iSRij, "I").Value < 1 Then
Rows(iSRij).Select
Selection.Delete Shift:=xlUp
ElseIf Cells(iSRij, "H").HasFormula = False And Cells(iSRij, "H").Value > 1 Then
Cells(iSRij, "F").Value = Cells(iSRij, "F").Value - Cells(iSRij, "H").Value
Cells(iSRij, "H").Value = 0
End If
                  
          If Cells(iSRij, "E") = 100 Then
          Cells(iSRij, "K").Value = 0
          End If
                  
                                    
 If Cells(iSRij, "K").HasFormula = False And Cells(iSRij, "L").Value < 1 And Cells(iSRij, "M") <> "" And _
 Cells(iSRij, "E") <> 100 Then
 Cells(iSRij, "L").Value = ""
 Cells(iSRij, "K").Offset(-1).Copy Destination:=Cells(iSRij, "k")
 End If
                            
        If Cells(iSRij, "F").HasFormula = False And Cells(iSRij, "G") <> "" Then
            Cells(iSRij, "F").Value = Cells(iSRij, "G").Value
            Cells(iSRij, "G").Value = ""
        End If
      
        If Cells(iSRij, "F").HasFormula = False And Cells(iSRij, "H") < 0 Then
            Cells(iSRij, "F").Value = Cells(iSRij, "I").Value
            Cells(iSRij, "H").Value = ""
        End If
  
    Next
 
    Range("F2").Value = DateSerial(Year(Now()) - 1, 12, 31)
    Range("J2").Value = DateSerial(Year(Now()) - 1, 12, 31)
    Range("I2").Value = DateSerial(Year(Now()), 12, 31)
    Range("M2").Value = DateSerial(Year(Now()), 12, 31)

Application.StatusBar = "Klaar"
End If
MsgBox ("Ook eens nagaan of in kolom K overal een formule staat!")
End Sub

Echter had ik altijd het volgende probleem bij het wissen van mijn lijnen als er een investering uitgeboekt werd. Dus zoals je in de macro kan lezen als er een bedrag in kolom H staat....
In de excel zie je dus overal subtotalen. En elke keer kreeg ik foutmelding 23.
Dus omdat die lijnen gewist werden klopte de formule niet meer, dus ik kreeg dan een verwijzings fout. Als ik dan het bereik van het subtotaal 1 cel hoger liet uitkomen dan de cellen met getallen dan was het probleem weg omdat er nog een rij met niets blijft staat waarop de formule slaat.
Maar in de grote sheet staan de meeste subtotalen met een bereik met enkel gevulde cellen.
Hoe kan ik dit oplossen? Of hoe kan ik alle formules ineens aanpassen dat het bereik met 1 cel naar boven moet uitgebreid worden en dan mag er pal boven ook geen subtotaal staan want anders klopt het helemaal niet meer.
Ik weet niet goed hoe ik dit probleem kan oplossen.

Groeten,
Mark