VBA for VERTICAL formula posting every 20 rows

erickguz

Board Regular
Joined
May 11, 2010
Messages
58
Hello,

I keep having to change dozens of rows formatting. I don't know if there is an easier way. I need to copy and paste/format sometimes hundreds of rows that are spaced twenty rows apart - the rows in between have other data/charts.

For example, I have every 20th row in column A, row 15, 35, 55, 75, etc., where I need to change formatting that includes Fill Color, Font Color and Font if possible?

Thank you.
Erick
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
you can try this out

I added comments to the stuff you can change

Code:
Sub FormatEvery20()
Dim r As Range
Dim c As Integer
c = 15
Do Until c > 100 'change this number to anything higher than your last possible row
    Range("A" & c).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535 'this is your color for the highlight of the cell
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Name = "Agency FB" 'this is the font style
        .Size = 11 'this is the font size
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .Color = -16776961 'this is font color
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    c = c + 20
    Loop
End Sub
 
Last edited:
Upvote 0
If you run this macro, it will ask for an interval (default 20)
It will then select the ActiveCell and every cell that interval below the active Cell.
You can then manually format all those cells en masse.

Code:
Sub SelectEveryNthRow()
    Dim RowInterval As Long, i As Long, lastRow As Long
    Dim SelRows As Range
    RowInterval = Application.InputBox("row interval", Default:="20", Type:=1)
    
    If RowInterval <= 0 Then
        Rem cancel pressed
    Else
        With ActiveCell
            Set SelRows = .Cells(1, 3)
            lastRow = .EntireColumn.Cells(Rows.Count, 1).End(xlUp).Row
            For i = .Row To .EntireColumn.Cells(Rows.Count, 1).End(xlUp).Row Step RowInterval
                Set SelRows = Application.Union(SelRows, .EntireColumn.Cells(i, 1))
            Next i
            Set SelRows = Application.Intersect(SelRows, ActiveCell.EntireColumn)
            
        End With
        SelRows.Select
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

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
Back
Top