How to loop a formula in different cells in excel vba?

Question

I have a piece of code where I sum the cell "K6" from every sheet of the workbook appart the main one called "Data". However it is hard coded and I would like to be able to loop it. Either this or establishing a formula and than extending it. I think it will be easier to see what I'm talking about by looking at the code

This is what I have already

`Sub SumSheets()

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Data" Then

SumTotal = SumTotal + ws.Range("K6").Value
SumTotal2 = SumTotal + ws.Range("K7").Value
SumTotal3 = SumTotal + ws.Range("K8").Value
SumTotal4 = SumTotal + ws.Range("K9").Value

End If

Next

Sheets("Data").Range("A6").FormulaR1C1 = SumTotal
Sheets("Data").Range("A7").FormulaR1C1 = SumTotal2
Sheets("Data").Range("A8").FormulaR1C1 = SumTotal3
Sheets("Data").Range("A9").FormulaR1C1 = SumTotal4

End Sub'

This piece of code works like I want it to, but it would be much easier if I could find a way to loop it. Or maybe establish SumTotal as a function and extend it like in regular excel.

Sub SumSheets()

Dim ws As Worksheet
Dim i As Integer
Dim j As Integer

For Each ws In ThisWorkbook.Worksheets

If ws.Name <> "Data" Then

SumTotal = SumTotal + ws.Range("K6").Value
SumTotal2 = SumTotal + ws.Range("K7").Value
SumTotal3 = SumTotal + ws.Range("K8").Value
SumTotal4 = SumTotal + ws.Range("K9").Value

For i = SumTotal To SumTotal4
For j= 6 To 10

Cells(j,1).Value = i

Next j
Next i

End If

Next

End Sub'

The result with the For Loop I tried is that it only put the value of SumTotal4 in cells 6 through ten. I'm guessing it's because i haven't defined i well enough.

Answer 1

As a UDF:

Function SumAll(addr As String)
    Application.Volatile
    Dim ws As Worksheet, tot
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" Then tot = tot + ws.Range(addr).Value
    Next ws
    SumAll = tot
End Function

Then (eg) in A6 you can enter:

=SumAll("K6")

or better:

Function SumAll(c As Range)
    Application.Volatile
    Dim ws As Worksheet, tot
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Data" Then tot = tot + ws.Range(c.Address(False, False)).Value
    Next ws
    SumAll = tot
End Function

then you can us (eg)

=SumAll(K6)

and it will adjust as you drag down

Answer 2

You could also have it as a sub which concatenates a string and you can use the .Formula property to assign it to a range. Excel will automatically update the formula.

For example if you wanted A1 in "Test" to display the sum of K6 in all those worksheets whose name is not data, A2 to display all those with K7 etc.The following would work:

Sub test()
Dim str1 As String, str2 As String
Dim ws As Worksheet, i As Integer, j As Integer


j = 0

'As data pertains to one spreadsheets name

i = ThisWorkbook.Worksheets.Count - 1

For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Data" Then
    j = j + 1
    If i - j = 0 Then
        str1 = "'" & ws.Name & "'!K6 "
    Else
        str1 = "'" & ws.Name & "'!K6, "
    End If
    str2 = str2 & str1
End If
Next ws

ThisWorkbook.Worksheets("Test").Range("A1:A7").Formula = "=sum(" & str2 & ")"


End Sub

The added bonus being that you can track your formula through your worksheet if that is of interest.

For your query below, modify the if function with str1 to:

    If i - j = 0 Then
        str1 = "abs('" & ws.Name & "'!E6)/('" & ws.Name & "'!K6) "
    Else
        str1 = "abs('" & ws.Name & "'!E6)/('" & ws.Name & "'!K6), "
    End If

The last line should also change:

ThisWorkbook.Worksheets("Data").Range("A1:A7").Formula = "=average(" & str2 & ")"