Automatic calculation of the average values in alternating columns.

Hello everyone,

I’ve code (thanks to Saurabhjaina211), that inserts blanc columns between columns with data and makes calculations. I still have to manually make calculations of the average value at the bottom of the columns with percentage values. I was wandering if it is possible to automatically calculate average percentage of the values of the alternating columns with data in percentage format. The number of rows as well as number of columns are flexible, alternating columns start from column E. Would be grateful for any help.

P.S. Please find sample of the table as an attachment to this post.

Dilshod

Sub TableResults()
'....

Dim colNo, colStart, colFinish, colStep As Long
Dim rng2Insert As Range

colStep = 2

colStart = Application.Cells(1, 4).Column + 1

colFinish = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column * 2) - colStart

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


    For colNo = colStart To colFinish Step colStep
        ActiveSheet.Cells(1, colNo).EntireColumn.Insert

        '***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        ActiveSheet.Cells(2, colNo) = "=(RC[-1]-RC[colNo-2])/RC[colNo-2]"
        ActiveSheet.Cells(2, colNo).Columns(colNo).AutoFill
        '***
    Next
   
'***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        '***

Dim colFinish2 As Integer, totalRows As Integer

colFinish2 = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)

totalRows = WorksheetFunction.CountA(ActiveSheet.Range("B:B"))

On Error Resume Next

'Application.ScreenUpdating = False

    For colNo = 5 To colFinish Step 2

        With ActiveSheet

            For rowno = 2 To totalRows

            .Cells(rowno, colNo) = (.Cells(rowno, colNo - 1) - .Cells(rowno, 3)) / .Cells(rowno, 3)

            Next

        End With

    Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.CutCopyMode = False

End Sub

Quote from KjBox

The simplest solution is to use an Excel Built-in Table with a Totals Row rather than a manually created table.

This table is not created manually, the code published is part of the code that copies and transposes data from one table to another one, to simplify explanation I decided to publish part of the code. I know how to calculate totals in Excel for a single column, but I do not know how to do that for multiple alternating columns.

Quote from KjBox

What I meant by "manually created" was a table of data that was not in an Excel Built-in, the fact that code was used to make it makes no difference.

If, however you do not wish to use Excel Built-in Tables then this will remove any Total Averages that are already there and add new ones.

Hi KjBox,

Thanks very much for your help. Though there might be an error in your formula as there is quite a big discrepancy between manually calculated averages (if we assume formula is =AVERAGE(E2:E361)) Excel calculation for the column E gives 3.79% and result of your VBA code is 8.85%, the same is with the rest of the column results. Thanks for your time anyway.

Dilshod

Hi KjBox,

Thanks a lot for your help! It works perfectly well. Obviously I would not be able to sort it out on my own.

Highly appreciate it.

Dilshod

Quote from KjBox

You're welcome. Thanks for the "Like"

Hello KjBox,

Sorry its me again. It gives error message (Type mismatch, Line#12 of the code) with another seemingly identical table.

Is there any chance you could help me to figure out reason for that error?

Please find attached file with Sheet2.

Thanks in advance,

Dilshod

Thank you very much!

Appreciate it.