Loop the Macro to next row until end of sheet

mrKY

New Member
Joined
Jul 6, 2022
Messages
1
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
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:

VBA Code:
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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
12,132
Office Version
  1. 2013
  2. 2010
Platform
  1. Windows
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

Well-known Member
Joined
Jul 30, 2012
Messages
1,010
Office Version
  1. 2016
Platform
  1. Windows
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.
VBA Code:
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
 

Forum statistics

Threads
1,175,475
Messages
5,897,659
Members
434,667
Latest member
Ftdsa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top