SOLVED

Average calculation on different cells range

Copper Contributor

Hi everybody, can someone help me to solve this problem? I need to calculate hundreds of average but any of this is based on a range made by different number of cells. I.E. first range is made by 45 cells. I need to calculate the average of the first/second/third quarter of range. The second range is made by 66 cells and, as before, i need the average of the first/second/third quarter of range. The third is made by 75 cells..and so on..i have dozens of ranges and i am wondering if there is a way to avoid to do this calculation by hand for each of them. Thanks

4 Replies
Post few sample data or attach a sample workbook and show your desired output.

@Harun24HR Hope it's clear now..Different number of cells range and need to calculate the average of the first/second/third quarter of each one..Is there a formula able to avoid this long and boring activity? Thanks

Giorgione_0-1663162422415.png

 

best response confirmed by Hans Vogelaar (MVP)
Solution

@Giorgione 

An alternative could be the macro in the attached file. Enter numbers in columns A and B, G and H and in M and N and then run the macro. The number of rows has to be a multiple of 3 otherwise the macros returns a message.

Sub third()

Dim i As Long
Dim j As Long
Dim k As Long
Dim l, m, n As Long

i = Range("A" & Rows.Count).End(xlUp).Row - 1

If i Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns A and B ")
Else
End If

j = i / 3

Cells(1, 4).Value = Application.WorksheetFunction.Average(Range(Cells(2, 1), Cells(j + 1, 1)))
Cells(2, 4).Value = Application.WorksheetFunction.Average(Range(Cells(j + 2, 1), Cells(j * 2 + 1, 1)))
Cells(3, 4).Value = Application.WorksheetFunction.Average(Range(Cells(j * 2 + 2, 1), Cells(i + 1, 1)))

Cells(1, 6).Value = Application.WorksheetFunction.Average(Range(Cells(2, 2), Cells(j + 1, 2)))
Cells(2, 6).Value = Application.WorksheetFunction.Average(Range(Cells(j + 2, 2), Cells(j * 2 + 1, 2)))
Cells(3, 6).Value = Application.WorksheetFunction.Average(Range(Cells(j * 2 + 2, 2), Cells(i + 1, 2)))


k = Range("G" & Rows.Count).End(xlUp).Row - 1

If k Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns G and H ")
Else
End If

l = k / 3

Cells(1, 10).Value = Application.WorksheetFunction.Average(Range(Cells(2, 7), Cells(l + 1, 7)))
Cells(2, 10).Value = Application.WorksheetFunction.Average(Range(Cells(l + 2, 7), Cells(l * 2 + 1, 7)))
Cells(3, 10).Value = Application.WorksheetFunction.Average(Range(Cells(l * 2 + 2, 7), Cells(k + 1, 7)))

Cells(1, 12).Value = Application.WorksheetFunction.Average(Range(Cells(2, 8), Cells(l + 1, 8)))
Cells(2, 12).Value = Application.WorksheetFunction.Average(Range(Cells(l + 2, 8), Cells(l * 2 + 1, 8)))
Cells(3, 12).Value = Application.WorksheetFunction.Average(Range(Cells(l * 2 + 2, 8), Cells(k + 1, 8)))


m = Range("M" & Rows.Count).End(xlUp).Row - 1

If k Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns M and N ")
Else
End If

n = m / 3

Cells(1, 16).Value = Application.WorksheetFunction.Average(Range(Cells(2, 13), Cells(n + 1, 13)))
Cells(2, 16).Value = Application.WorksheetFunction.Average(Range(Cells(n + 2, 13), Cells(n * 2 + 1, 13)))
Cells(3, 16).Value = Application.WorksheetFunction.Average(Range(Cells(n * 2 + 2, 13), Cells(m + 1, 13)))

Cells(1, 18).Value = Application.WorksheetFunction.Average(Range(Cells(2, 14), Cells(n + 1, 14)))
Cells(2, 18).Value = Application.WorksheetFunction.Average(Range(Cells(n + 2, 14), Cells(n * 2 + 1, 14)))
Cells(3, 18).Value = Application.WorksheetFunction.Average(Range(Cells(n * 2 + 2, 14), Cells(m + 1, 14)))

End Sub

third.JPG

 

What can i say? You're a genius!! Thanks a lot..
1 best response

Accepted Solutions
best response confirmed by Hans Vogelaar (MVP)
Solution

@Giorgione 

An alternative could be the macro in the attached file. Enter numbers in columns A and B, G and H and in M and N and then run the macro. The number of rows has to be a multiple of 3 otherwise the macros returns a message.

Sub third()

Dim i As Long
Dim j As Long
Dim k As Long
Dim l, m, n As Long

i = Range("A" & Rows.Count).End(xlUp).Row - 1

If i Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns A and B ")
Else
End If

j = i / 3

Cells(1, 4).Value = Application.WorksheetFunction.Average(Range(Cells(2, 1), Cells(j + 1, 1)))
Cells(2, 4).Value = Application.WorksheetFunction.Average(Range(Cells(j + 2, 1), Cells(j * 2 + 1, 1)))
Cells(3, 4).Value = Application.WorksheetFunction.Average(Range(Cells(j * 2 + 2, 1), Cells(i + 1, 1)))

Cells(1, 6).Value = Application.WorksheetFunction.Average(Range(Cells(2, 2), Cells(j + 1, 2)))
Cells(2, 6).Value = Application.WorksheetFunction.Average(Range(Cells(j + 2, 2), Cells(j * 2 + 1, 2)))
Cells(3, 6).Value = Application.WorksheetFunction.Average(Range(Cells(j * 2 + 2, 2), Cells(i + 1, 2)))


k = Range("G" & Rows.Count).End(xlUp).Row - 1

If k Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns G and H ")
Else
End If

l = k / 3

Cells(1, 10).Value = Application.WorksheetFunction.Average(Range(Cells(2, 7), Cells(l + 1, 7)))
Cells(2, 10).Value = Application.WorksheetFunction.Average(Range(Cells(l + 2, 7), Cells(l * 2 + 1, 7)))
Cells(3, 10).Value = Application.WorksheetFunction.Average(Range(Cells(l * 2 + 2, 7), Cells(k + 1, 7)))

Cells(1, 12).Value = Application.WorksheetFunction.Average(Range(Cells(2, 8), Cells(l + 1, 8)))
Cells(2, 12).Value = Application.WorksheetFunction.Average(Range(Cells(l + 2, 8), Cells(l * 2 + 1, 8)))
Cells(3, 12).Value = Application.WorksheetFunction.Average(Range(Cells(l * 2 + 2, 8), Cells(k + 1, 8)))


m = Range("M" & Rows.Count).End(xlUp).Row - 1

If k Mod 3 <> 0 Then
MsgBox ("Please enter number of rows multiple of 3 in columns M and N ")
Else
End If

n = m / 3

Cells(1, 16).Value = Application.WorksheetFunction.Average(Range(Cells(2, 13), Cells(n + 1, 13)))
Cells(2, 16).Value = Application.WorksheetFunction.Average(Range(Cells(n + 2, 13), Cells(n * 2 + 1, 13)))
Cells(3, 16).Value = Application.WorksheetFunction.Average(Range(Cells(n * 2 + 2, 13), Cells(m + 1, 13)))

Cells(1, 18).Value = Application.WorksheetFunction.Average(Range(Cells(2, 14), Cells(n + 1, 14)))
Cells(2, 18).Value = Application.WorksheetFunction.Average(Range(Cells(n + 2, 14), Cells(n * 2 + 1, 14)))
Cells(3, 18).Value = Application.WorksheetFunction.Average(Range(Cells(n * 2 + 2, 14), Cells(m + 1, 14)))

End Sub

third.JPG

 

View solution in original post