Loop the Macro to next row until end of sheet

[mrKY]

Hi Experts,

I have a file with a lot of data where i have to apply some formulas and formatting to make the data more presentable and easier to simulate certain scenarios.
There are over 5000 rows in the file. Discounting the first 2 rows for the headers, every 18 rows after that has data relating to a unique product.

I am super new to macros, and have attempted to create a macro on what i would like to do with the rows and datas for a unique product.
The problem is, i am able to only apply the macro on the first unique product, how do i edit my code so that this macro loops through to the next 18 rows of unique products and go down the list until the end of the sheet?

Apologies for the messy code as again, i am very new to this:

Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").EntireColumn.AutoFit
    ActiveWindow.SmallScroll Down:=-15
    Rows("21:22").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F21").Select
    ActiveWindow.SmallScroll Down:=-3
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-5]C[-1]+R[-12]C-R[-18]C"
    Range("G21").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-1]+R[-12]C-R[-18]C"
    Range("F22").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/SUM(R[-19]C[1]:R[-19]C[30])*30"
    Range("F23").Select
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 1
    Range("F22").Select
    Selection.AutoFill Destination:=Range("F22:G22"), Type:=xlFillDefault
    Range("F22:G22").Select
    Range("G21:G22").Select
    Selection.AutoFill Destination:=Range("G21:CP22"), Type:=xlFillDefault
    Range("G21:CP22").Select
    ActiveWindow.ScrollColumn = 75
    ActiveWindow.ScrollColumn = 74
    ActiveWindow.ScrollColumn = 73
    ActiveWindow.ScrollColumn = 71
    ActiveWindow.ScrollColumn = 70
    ActiveWindow.ScrollColumn = 69
    ActiveWindow.ScrollColumn = 68
    ActiveWindow.ScrollColumn = 67
    ActiveWindow.ScrollColumn = 66
    ActiveWindow.ScrollColumn = 65
    ActiveWindow.ScrollColumn = 63
    ActiveWindow.ScrollColumn = 59
    ActiveWindow.ScrollColumn = 55
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 43
    ActiveWindow.ScrollColumn = 41
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("F21:F22").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.NumberFormat = "#,##0.00_);(#,##0.00)"
    Selection.NumberFormat = "#,##0.0_);(#,##0.0)"
    Selection.NumberFormat = "#,##0_);(#,##0)"
    ActiveWindow.ScrollColumn = 75
    ActiveWindow.ScrollColumn = 74
    ActiveWindow.ScrollColumn = 73
    ActiveWindow.ScrollColumn = 71
    ActiveWindow.ScrollColumn = 57
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 1
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C18").Select
    Selection.Copy
    Range("C22").Select
    ActiveSheet.Paste
    Range("C18").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A20:B20").Select
    Selection.Copy
    Range("A22").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[rollis13]

Did my best to match your recorded macro, here is what I came up with. Since you didn't attach some XL2BB I'm assuming the your 'products' are in column A. If it doesn't match you can use it as a trace that you can integrate/fix.

Option Explicit
Sub test()
    Dim rCount      As Long
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:B").EntireColumn.AutoFit
    rCount = 3                                    'start from row 3 (use 20 to skip checking first product)
    Do
        'check if products are different
        If (Cells(rCount, "A") <> Cells(rCount + 1, "A")) Then 'check if products are different
            rCount = rCount + 1
            Rows(rCount & ":" & rCount + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Range("F" & rCount).FormulaR1C1 = "=R[-5]C[-1]+R[-12]C-R[-18]C"
            Range("G" & rCount).FormulaR1C1 = "=RC[-1]+R[-12]C-R[-18]C"
            Range("F" & rCount + 1).FormulaR1C1 = "=R[-1]C/SUM(R[-19]C[1]:R[-19]C[30])*30"
            Range("F" & rCount + 1).AutoFill Destination:=Range("F" & rCount + 1 & ":G" & rCount + 1), Type:=xlFillDefault
            Range("G" & rCount & ":G" & rCount + 1).AutoFill Destination:=Range("G" & rCount & ":CP" & rCount + 1), Type:=xlFillDefault
            Range("F" & rCount & ":F" & rCount + 1).Select
            Range(Selection, Selection.End(xlToRight)).Select
            Selection.NumberFormat = "#,##0_);(#,##0)"
            With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            Range("C" & rCount - 3).Copy Range("C" & rCount + 1)
            Application.CutCopyMode = False
            Range("C" & rCount - 3).ClearContents
            Range("A" & rCount - 1 & ":B" & rCount - 1).Copy Range("A" & rCount + 1)
            Application.CutCopyMode = False
            rCount = rCount + 1
        End If
        rCount = rCount + 1
    Loop Until Cells(rCount, "A") = ""            'do until column A is empty
End Sub