change function add and remove rows

[Tommy]

I changed this:

Sub SelectTest()
Dim helfer As Range
Dim Tabelle As ListObject
Dim i As Integer
i = 3
j = 1
Set helfer = Selection
Set Tabelle = Range("SummeMA").ListObject

If Range(Tabelle).Cells(3, j).HasFormula = True And InStr(1, Range(Tabelle).Cells(3, j).Formula, "-" & Zelle) <> 0 Then

    While i < 55
    
        helfer.EntireRow.Cells(1, i).Select
        Zelle = ActiveCell.Address(0, 0)
   
        alteFormel = Range(Tabelle).Cells(3, j).Formula
        neueFormel = Replace(alteFormel, "-" & Zelle, "")
        Range(Tabelle).Cells(3, j).Formula = neueFormel
    
        i = i + 1
        j = j + 1
    
    Wend
    
Else
    
    While i < 55
    
        helfer.EntireRow.Cells(1, i).Select
        Zelle = ActiveCell.Address(0, 0)

        alteFormel = Range(Tabelle).Cells(3, j).Formula
        neueFormel = alteFormel + "-" & Zelle
        Range(Tabelle).Cells(3, j).Formula = neueFormel
    
        i = i + 1
        j = j + 1
    Wend
    
End If
End Sub

To this

Sub SelectTest()



Dim helfer As Range
Dim Tabelle As ListObject
Dim i As Integer
i = 3
j = 1
Set helfer = Selection
Set Tabelle = Range("SummeMA").ListObject

If Range(Tabelle).Cells(3, j).HasFormula = True And InStr(1, Range(Tabelle).Cells(3, j).Formula, "-" & Zelle) <> 0 Then

    While i < 55
    
        Zelle = helfer.EntireRow.Cells(1, i).Address(0, 0)
        Range(Tabelle).Cells(3, j).Formula = Replace(Range(Tabelle).Cells(3, j).Formula, "-" & Zelle, "")
    
        i = i + 1
        j = j + 1
    
    Wend
    
Else
    
    While i < 55
    
        Zelle = helfer.EntireRow.Cells(1, i).Address(0, 0)
        Range(Tabelle).Cells(3, j).Formula = Replace(Range(Tabelle).Cells(3, j).Formula, "-" & Zelle, "")
    
        i = i + 1
        j = j + 1
    Wend
    
End If
End Sub