How to fill the formula of below pattern through VBA but retain the formulae in cells?

Question

I want to add the formulae with a pattern as below across the rows. Is there an easy way through VBA?

Cell AB16 = SUM(AC9:AC13)/SUM(AB9:AB13)

Cell AC16 = SUM(AD8:AD12)/SUM(AC8:AC12) 

Cell AD16 = SUM(AE7:AE11)/SUM(AD7:AD11)

Cell AE16 = SUM(AF6:AF10)/SUM(AE6:AE10)

Cell AF16 = SUM(AG5:AG9)/SUM(AF5:AF9)

....

And so on.

I tried extracting the formula using .formula function and trying to create individual loops to absorb the increasing pattern in alphabets and decreasing pattern in numbers. Here the issue I am facing is till A to z I can increment the loop from ascii 65 to 90. Beyond z, it gets tedious as I need to jump to AA.

Is there a better way to achieve the above formula fill across rows via VBA but I want the formula format to be as above Sum(xxx:xxx)/sum(yyy:yyy)? The constraint is, I can not have hard coded numbers ran through macro in these cells. Also, can't afford to have offset formula in these cells too. These cells are capable of taking in only Sum(xxx:xxx)/sum(yyy:yyy) format.

VBasic2008 · Answer 1 · 2022-01-08T08:46:40.637

Write a Formula (VBA)

Option Explicit

Sub WriteSumsDivision()
    
    Const rAddress As String = "AB16:AF16"
    Const rOffset As Long = 22
    Const cSize As Long = 5
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve
    Dim rrg As Range: Set rrg = ws.Range(rAddress)
    Dim fCol As Long: fCol = rrg.Cells(1).Column
    Dim cCount As Long: cCount = rrg.Columns.Count
    Dim cOffset As Long: cOffset = rOffset - fCol
    Dim MaxOffset As Long: MaxOffset = cSize - rOffset + 1
    
    Dim rCell As Range
    Dim rArr As Variant: ReDim rArr(1 To cCount)
    Dim cFormula As String
    Dim c As Long
     
    For Each rCell In rrg.Cells
        c = c + 1
        cOffset = cOffset - 1
        If cOffset > MaxOffset Then
            cFormula = "=SUM(" & rCell.Offset(cOffset, 1) _
                .Resize(cSize).Address(0, 0) & ")/SUM(" _
                & rCell.Offset(cOffset).Resize(cSize).Address(0, 0) & ")"
            rArr(c) = cFormula
        Else
            Debug.Print "Limit hit."
            Exit For
        End If
    Next rCell

    rrg.Formula = rArr

End Sub

This is quite close to what I am currently wrote, thank you so much for filling the gaps. — Naive_Natural2511, Jan 08 '22 at 08:40
Could you please share what's wrong with it so I can improve? — VBasic2008, Jan 08 '22 at 08:44

score 1 · Accepted Answer · answered Jan 08 '22 at 07:40

As usual with Excel, you don't need to concern yourself with alphabets. Rows and columns are actually numbered, the letters only appear in the end and only for your convenience. You are free to ignore them and speak in R1C1 which is the Excel's native language:

Dim target As Range
Set target = Range("AB16:AF16")

Dim start_offset As Long
start_offset = 2

Dim c As Range
For Each c In target
  c.FormulaR1C1 = "=SUM(R[-" & (start_offset + 5) & "]C[1]:R[-" & (start_offset + 1) & "]C[1])/SUM(R[-" & (start_offset + 5) & "]C:R[-" & (start_offset + 1) & "]C)"
  start_offset = start_offset + 1
Next

Wow! You are a star! Thank you for saving my day! – Naive_Natural2511 Jan 08 '22 at 08:39 — Naive_Natural2511, Jan 08 '22 at 08:39

How to fill the formula of below pattern through VBA but retain the formulae in cells?

2 Answers2

Write a Formula (VBA)