CODEWITHSUNDEEP
excelvbaloops
Oliver Theseira
Oliver Theseira

Reputation: 57

How do I loop across specific ranges with the row number as the variable?

I have a bunch of formulae that is meant for specific (non-contiguous) ranges in my data. Is there any way to do this in less lines with an array and/or a loop?

.Range("R" & RowA).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowA).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowA).FormulaR1C1 = "=RC[-12]*RC[-2]"

.Range("R" & RowB).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowB).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowB).FormulaR1C1 = "=RC[-12]*RC[-2]"

.Range("R" & RowC).FormulaR1C1 = "=RC[-1]"
.Range("W" & RowC).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
.Range("Y" & RowC).FormulaR1C1 = "=RC[-12]*RC[-2]"

Upvotes: 2

Views: 437

Answers (4)

VBasic2008
VBasic2008

Reputation: 54767

Using 'Helper' Procedures

Option Explicit

Sub UsingRefRows()
    
    Const RowA As Long = 1
    Const RowB As Long = 3
    Const RowC As Long = 5
    
    Dim ws As Worksheet: Set ws = Sheet1
    
    Dim rrg As Range: Set rrg = RefRows(ws, RowA, RowB, RowC)
    
    Intersect(rrg, ws.Columns("R")).FormulaR1C1 = "=RC[-1]"
    Intersect(rrg, ws.Columns("W")).FormulaR1C1 = "=RC[-5]*RC[-7]+RC[-2]"
    Intersect(rrg, ws.Columns("Y")).FormulaR1C1 = "=RC[-12]*RC[-2]"

End Sub

Sub UsingRefRowsAndWriteRowsR1C1()
    
    Const RowA As Long = 1
    Const RowB As Long = 3
    Const RowC As Long = 5
    
    Const ColumnsList As String = "R,W,Y"
    Const FormulasList As String _
        = "=RC[-1]" & "," _
        & "=RC[-5]*RC[-7]+RC[-2]" & "," _
        & "=RC[-12]*RC[-2]"
    
    Dim ws As Worksheet: Set ws = Sheet1
    
    Dim rrg As Range: Set rrg = RefRows(ws, RowA, RowB, RowC)
    
    WriteRowsR1C1 rrg, ColumnsList, FormulasList
    
End Sub


Function RefRows( _
    ByVal ws As Worksheet, _
    ParamArray DataRows() As Variant) _
As Range
    Dim rg As Range
    Dim n As Long
    For n = 0 To UBound(DataRows)
        If rg Is Nothing Then
            Set rg = ws.Rows(DataRows(n))
        Else
            Set rg = Union(rg, ws.Rows(DataRows(n)))
        End If
    Next n
    If Not rg Is Nothing Then
        Set RefRows = rg
    End If
End Function

Sub WriteRowsR1C1( _
        ByVal RowsRange As Range, _
        ByVal ColumnsList As String, _
        ByVal FormulasList As String)
    
    Dim Cols() As String: Cols = Split(ColumnsList, ",")
    Dim Formulas() As String: Formulas = Split(FormulasList, ",")
    Dim ws As Worksheet: Set ws = RowsRange.Worksheet
    
    Dim n As Long
    For n = 0 To UBound(Cols)
        Intersect(RowsRange, ws.Columns(Cols(n))).FormulaR1C1 = Formulas(n)
    Next n
    
End Sub

Upvotes: 2

Pᴇʜ
Pᴇʜ

Reputation: 57673

I would store the rows in an array, then use Union to collect all the rows in a variable and Intersect that with each column.

This way you can access all defined rows of a specific column at once.

Option Explicit

Public Sub example()
    Dim RowArr() As Variant
    RowArr = Array(1, 3, 17) 'define your rows here
    
    Dim AllRows As Range
        
    With ActiveSheet
        Dim Row As Variant
        For Each Row In RowArr
            If AllRows Is Nothing Then
                Set AllRows = .Rows(Row)
            Else
                Set AllRows = Union(AllRows, .Rows(Row))
            End If
        Next Row
        
        'write in all rows of a specific column
        Intersect(.Columns("R"), AllRows).FormulaR1C1 = "=RC[-1]"
        Intersect(.Columns("W"), AllRows).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
        Intersect(.Columns("Y"), AllRows).FormulaR1C1 = "=RC[-12]*RC[-2]"
    End With
End Sub

Instead of the loop you can also write:

Set AllRows = .Range("1:1,3:3,17:17")

like

Option Explicit

Public Sub example()
    With ActiveSheet
        Dim AllRows As Range
        Set AllRows = .Range("1:1,3:3,17:17")
        
        'write in all rows of a specific column
        Intersect(.Columns("R"), AllRows).FormulaR1C1 = "=RC[-1]"
        Intersect(.Columns("W"), AllRows).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
        Intersect(.Columns("Y"), AllRows).FormulaR1C1 = "=RC[-12]*RC[-2]"
    End With
End Sub

but this works only for a smaller amount of rows. If you have more you need to use Union

Upvotes: 3

Capt.Krusty
Capt.Krusty

Reputation: 627

Maybe something like this:

Sub Test()
Dim letters, rows, i, letter, row

letters = Array("R", "W", "Y")
rows = Array(1, 5, 17)          'RowA, RowB, and so on...
i = 0
j = 0
For Each row In rows
    For Each letter In letters
        Debug.Print letters(i) & rows(j)
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=RC[-1]"
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
    '    .Range(letters(i) & rows(i)).FormulaR1C1 = "=RC[-12]*RC[-2]"
         
        i = i + 1
    Next letter
    j = j + 1
    i = 0
Next row

End Sub

Upvotes: 2

Spencer Barnes
Spencer Barnes

Reputation: 2877

Yes, although I suspect not quite in the way you're thinking. Use an array instead of separate variables RowA, RowB and RowC, so you'd replace

Dim RowA as Long, RowB as Long, RowC as Long
RowA = 1
RowB = 3
RowC = 7 'example figures

With -

Dim Row(1 to 3) as Long
Row(1) = 1
Row(2) = 3
Row(3) = 7

Then your above code can be shortened to the following loop:

For a = Lbound(Row) to Ubound(Row)
    .Range("R" & Row(a)).FormulaR1C1 = "=RC[-1]"
    .Range("W" & Row(a)).FormulaR1C1 = "=(RC[-5]*RC[-7])+RC[-2]"
    .Range("Y" & Row(a)).FormulaR1C1 = "=RC[-12]*RC[-2]"
Next

Upvotes: 2

Related Questions