Problem with converting formulas from absolute to relative. References shift

Question

*EDIT The problem is not to copy stuff, the problem is with macro shifting. I just described it, so you know where i'm coming from.

I have packets of data(numbers), each with 15 columns and varying amount of rows. One of the things i need to do for each of those packets is to get a sum of each column and then calculate the percentage for each column from total sum of said packet. To do this, i have a row right under a packet, which calculates the sum for each column and a row below that for percentage.

Since i have many of those packets, i wanted to write all formulas for 1 packet and then just copy them over to all others. Lets say 1st packet is in the range A1:O5. So my sums for each column are in A6:O6 and percentages in A7:O7. My formula for percentage is =A1/SUM($A$6:$O$6) for the 1st column and then i just pull it over for the rest.

To copy all the formulas over to other packets i need to covert them from absolute to relative. For that i have a macro. I select A7:O7 and execute my macro. The problem is, when i try to convert all percentage formulas shift to the right. So 1st formula will be fine =A1/SUM(A6:O6), but the 2nd will be =C1/SUM(B6:P6) instead of =B1/SUM(A6:O6), the 3rd =D1/SUM(C6:Q6) instead of =C1/SUM(A6:O6) and so on.

Here is my macro:

Sub convertFormulaToRelative()
    Dim calcOld As Long, screenOld As Boolean, eventsOld As Boolean, celL As Range
    calcOld = Application.Calculation
    screenOld = Application.ScreenUpdating
    eventsOld = Application.EnableEvents
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each celL In Selection
        With celL
            If .HasFormula Then .Formula = Application.ConvertFormula(.Formula, xlA1, , xlRelative)
        End With
    Next celL
    Application.Calculation = calcOld
    Application.ScreenUpdating = screenOld
    Application.EnableEvents = eventsOld
End Sub

What is wrong here? How do i fix it? I would like a fix for this macro, so i can use it in future and not a workaround for my specific problem.

If your formula is already =A1/SUM($A$6:$O$6) there's no need to convert it. As it is, copying it across one column will update it to =B1/SUM($A$6:$O$6) - Sheet1.Range("A7").Copy Destination:=Sheet1.Range("B7") Either that or you need to explain the locations of your packets a bit more. A picture helps. :) — Darren Bartrup-Cook
The problem is not to copy stuff, the problem is with macro shifting. I would like to know why it does it and how to fix it. — Ale

AcsErno AcsErno · Accepted Answer · 2021-08-26T07:20:30

This snippet fills in the rows under the input Range with sum and percentage. Assumptions: r points to data range

 Dim iRowCnt As Long
 Dim sSum As String
 Dim rSum As Range
 Dim iOffs As Long

 iRowCnt = r.Rows.Count
 iOffs = 0
 Set rSum = r.Resize(1).Offset(iRowCnt)  ' range to sum
 sSum = "SUM(" & rSum.Address & ")"   ' formula for adding all sum cells, e.g SUM($A$6:$O$6)
 
 For Each c In r.Resize(1).Offset(iRowCnt)
     c.FormulaLocal = "=SUM(" & r.Resize(,1).Offset(,iOffs).Address & ")"  ' =SUM($A$1:$A$5)
     c.Offset(1).FormulaLocal = "=" & r.Resize(1,1).Offset(,iOffs).Address & "/" & sSum ' =A1/SUM($A$6:$O$6)
     iOffs = iOffs + 1
 Next

If you need relative cell references, use.Address(0, 0)

Problem with converting formulas from absolute to relative. References shift

2 Answers