VBA Excel - deleting rows at specific intervals

Question

I am new to this forum, so bear with me.

I have a CSV-file that I need to apply some VBA-modules to in order to get the information I need.

In short, I have 3 macros that together to the following:

1. Create a new row every 20th row
2. Take the number from the cell above (column A) and fill the blank space in the new row with this number.
3. Sum the numbers in column H from the 20 rows before the new row to get a total score. This is done subsequently for as long as new rows appear (every 20th row).

Is it possible to get these three macros in a single macro? This would make it easier to hand down to others that may need to use these macros.

Current code:

' Step 1
Sub Insert20_v2()
    Dim rng As Range

    Set rng = Range("H2")
    While rng.Value <> ""
        rng.Offset(20).Resize(1).EntireRow.Insert
        Set rng = rng.Offset(21)
    Wend
End Sub

' Step 2
Sub FillBlanks()
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"

End Sub

' Step 3
Sub AutoSum()
    Const SourceRange = "H"
    Dim NumRange As Range, formulaCell As Range
    Dim SumAddr As String
    Dim c As Long

    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

Thank you for any help. Best,

Helge

Answer 1

You can create a single Sub calling all the other subs that you have created.

Example:

Sub DoAllTasks()

    Insert20_v2
    FillBlanks
    AutoSum

End Sub

Then you just have to create a button and assign the DoAllTasks to it or run the macro directly.

HTH ;)

Answer 2

That Should'nt be that hard.

Public Sub main()
        'deklaration
        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