Autosum for dynamic columns and dynamic rows loop thru sheet and loop workbook

Question

I have a flat income statement and need formulas for all the total cells.

I need a vba code: first, autosum (two cells to left) Jan Total column, copy down the formula to last total row (Cost of Goods Sold Total); next autosum (four cells to left) Feb Total column, copy down the formula to last total row (Cost of Goods Sold Total), loop as many times needed. Next autosum Grand Total column (cell values of Jan, Feb, Mar, etc).

next, in column A, find first cell with "Total", autosum above cells, copy formula and paste end right. loop until last total row (Cost of Goods Sold Total)

lastly, repeat above to each worksheet (x,y,z, etc) in workbook.

enter image description here

for columns, I manually autosum columns, copy, paste formulas. for rows, I got to first cell that need autosum.

Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
ActiveCell.Offset(0, -1).Range("A1").Select
Cells.Find(What:="total", After:=ActiveCell, LookIn:=xlFormulas2, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Range("A1").Select

This works but is time consuming.

taller · Accepted Answer · 2023-11-10 19:39:21Z

Here comes the code to apply formulas for columns.

I'm not sure what's the logic about autosum above cells. e.g. income total

Option Explicit

Sub AutoColSum()
    Dim i As Long, aMth(1 To 12) As String
    Dim lastRow As Long, c As Range, ColCnt As Long
    Dim ColRng As Range, SumRng As Range
    Const HEADER_ROW = 4
    Const GRAND = "Grand Total"
    For i = 1 To 12
        aMth(i) = Format(DateSerial(2023, i, 1), "MMM yyyy Total")
    Next
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    If lastRow > HEADER_ROW + 1 Then
        For i = 1 To 12
            Set c = Range(HEADER_ROW & ":" & HEADER_ROW + 1).Find(What:=aMth(i), LookIn:=xlValues, _
                LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
            If Not c Is Nothing Then
                If i = 1 Then
                    Set SumRng = c.Offset(2)
                Else
                    Set SumRng = Union(SumRng, c.Offset(2))
                End If
                ColCnt = IIf(i = 1, 2, 4)
                Set ColRng = Range(Cells(HEADER_ROW + 2, c.Column), Cells(lastRow, c.Column))
                ColRng.FormulaR1C1 = "=SUM(RC[-" & ColCnt & "]:RC[-1])"
            End If
        Next
        Set c = Cells(HEADER_ROW, Columns.Count).End(xlToLeft)
        If StrComp(c.Value, GRAND, vbTextCompare) = 0 Then
            Set ColRng = Range(Cells(HEADER_ROW + 2, c.Column), Cells(lastRow, c.Column))
            ColRng.Formula = "=SUM(" & SumRng.Address(0, 0) & ")"
        End If
    End If
End Sub

Collectives™ on Stack Overflow

Autosum for dynamic columns and dynamic rows loop thru sheet and loop workbook

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related