CODEWITHSUNDEEP
excelvbaexcel-formula
nln
nln

Reputation: 31

How to populate formula in rows dynamically?

I drawing data from another Excel workbook so I never know how big the resulting table will be.

I need to sum the values in the columns into a row and dynamically expand the formula for the sum in the row to the last filled column.

I am able to find the yellow field. How do I dynamically populate the formula into the red fields?
Example

My attempt to autofill:

Sub IN7()

lr = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
lc = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByColumns, xlPrevious, False).Column

Range("B" & (lr + 2)).Value = "=sum(B2:B" & lr & ")"
Range("B" & (lr + 2)").AutoFill Range("B" & (lr + 2)" & lc)

End Sub

Upvotes: 3

Views: 143

Answers (3)

VBasic2008
VBasic2008

Reputation: 54807

Add Totals

Option Explicit

Sub AddTotals()

    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Calculate the last row and column.
    Dim lr As Long
    lr = ws.Cells.Find("*", ws.Cells(1), xlFormulas, xlPart, xlByRows, xlPrevious, False).Row
    Dim lc As Long
    lc = ws.Cells.Find("*", ws.Cells(1), xlFormulas, xlPart, xlByColumns, xlPrevious, False).Column
    
    ' Reference the first column range.
    Dim fcrg As Range: Set fcrg = ws.Range("B2", ws.Cells(lr, "B"))
    ' Write the address of the first column range to a string variable.
    ' Lock the rows with '(, 0)' so the formula will work for all columns.
    Dim fcrgAddress As String: fcrgAddress = fcrg.Address(, 0)

    ' Reference the first sum cell.
    Dim cell As Range: Set cell = ws.Cells(lr + 2, "B")
    ' Calculate the number of columns.
    Dim cCount As Long: cCount = lc - cell.Column + 1
    ' Reference the sum row range.
    Dim srrg As Range: Set srrg = cell.Resize(, cCount)
    
    ' Write the formula to the sum row range.
    srrg.Formula = "=SUM(" & fcrgAddress & ")"

End Sub

Fewer Variables and Find Method Arguments (Parameters)

Sub AddTotalsShort()

    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Calculate the last row and column.
    Dim lr As Long
    lr = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    Dim lc As Long
    lc = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    
    ' Write the address of the first column range to a string variable.
    Dim fcrgAddress As String
    fcrgAddress = ws.Range("B2", ws.Cells(lr, "B")).Address(, 0)

    ' Reference the sum row range.
    Dim srrg As Range
    With ws.Cells(lr + 2, "B")
        Set srrg = .Resize(, lc - .Column + 1)
    End With
    
    ' Write the formula to the sum row range.
    srrg.Formula = "=SUM(" & fcrgAddress & ")"

End Sub

Upvotes: 1

MikeWasos
MikeWasos

Reputation: 68

So what you are trying is to create a value that automatically detects the final row and column of a table, right? If this is the case, use this:

lr = Cells(Rows.Count, 1).End(xlUp).Row 'goes to the last row and then goes up to the last row with any value
lc = Cells(1, Columns.Count).End(xltoLeft).Column 'goes to the last column and then goes left to the last column with any value

Wish someone taught me this before.

Concerning the sum part, I don't quite get what you are trying to do. I think what you are trying to do is to expand this sum you do of this second row to the rest of the roads, right? Why not using a loop?

for i = 2 to lr
 cells(i, lc + 2).Value = WorksheetFunction.Sum(Range(Cells(i, 1), Cells(i, lc)))
next i

Hope it helps!!

Upvotes: 0

Edoardo
Edoardo

Reputation: 3

Definitely not a pro here but this might solve your problem.

Sub SumAllColumns()

  Dim a As Integer

  Range("B7").Select
  ActiveCell.FormulaR1C1 = "=+SUM(R[-5]C:R[-2]C)"
  Range("B7").Select

  a = Sheet1.UsedRange.Columns.Count

  Selection.AutoFill Destination:=Selection.Resize(1, a - 1)

End Sub

This assumes you have 4 rows and your first sum has to be in the cell B7, as per your example. If the number of rows is also variable then let me know and I will try to change it.

Upvotes: 0

Related Questions