Deleting specific intervals of rows in a csv file with VBA

Question

Thanks to some nice guys here at this forum, I have been able to use the following macro for something I need :

Public Sub main()
    'declaration
    Dim rng As Range
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long

    'Loop trough all rows
    Set rng = Range("H2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        Set rng = rng.Offset(21)
    Wend

   'Fill the Blank Rows in A
   Columns("A:A").Select
   Selection.SpecialCells(xlCellTypeBlanks).Select
   Selection.FormulaR1C1 = "=R[-1]C"


   For Each NumRange In Columns(SourceRange).SpecialCells(xlConstants, xlNumbers).Areas
       SumAddr = NumRange.Address(False, False)
       Set formulaCell = NumRange.Offset(NumRange.Count, 0).Resize(1, 1)
       formulaCell.Formula = "=SUM(" & SumAddr & ")"

       'change formatting to your liking:
       formulaCell.Font.Bold = True
       formulaCell.Font.Color = RGB(255, 0, 0)

       c = NumRange.Count
   Next NumRange

End Sub

In short, this creates a row every 20th row, takes the number from the cell above in column "A" in the blank row and sum up the 20th previous cells in column "H" to put a "total score" in the blank row.

I have one more question regarding this macro.

After having run the macro above, the "Sum" of 20 and 20 rows is placed in the new row added. Ideally, I would like to delete all of the 20 rows that have been summed and just have the added row left. The problem with this is the last part of the previous macro sums a given number of cells up, and if I delete the rows the summing will be wrong (as well as the number from the cell above in column A).

Is there any way to add something to the macro so that it deletes 20 and rows without effecting the summing and the number from the previous cell in column A?

It would look something like this: Delete rows 2-21, skip row 22, delete row 23-42, skip row 43, delete row 44-63, skip row 64 and so on.

I understand that this probably means having to alter the previous macro posted, but I guess it's worth asking.

Thanks in advance guys.

Best, Helge

Answer 1

Here you go:

Public Sub main()
    'declaration
    Dim rng As Range
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long
    Dim iFirstRow As Integer, iLastCell As Integer


    'Loop trough all rows in H column
    Set rng = Range(SourceRange & "2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        With rng.Offset(20)
            .Formula = "=sum(" & SourceRange & rng.Row & ":" & SourceRange & rng.Offset(19).Row & ")"
            .Formula = .Value2

           'change formatting to your liking:
            .Font.Bold = True
            .Font.Color = RGB(255, 0, 0)

            'set next group start
            Set rng = rng.Offset(21)

            'delete rows
            iFirstRow = .Column - 1
            With Range(.Offset(-20, -iFirstRow), .Offset(-1, -iFirstRow))

                iLastCell = .Cells(.Rows.Count, "A").End(xlUp).Row

                'Fill the Blank Rows in A
                With Cells(rng.Offset(-1).Row, 1)
                    .Formula = "=" & Cells(iLastCell, 1).Address
                    .Formula = .Value2
                End With

                'Delete group rows
                .EntireRow.Delete
            End With

        End With
    Wend
End Sub