3. The required calculations can be on any sheet in the workbook and the number of sheets in the workbooks could vary.
If there are 6 data blocks on a sheet, the cursor will be moved to Column G of any data block and the macro executed.
This means the macro would be executed 6 times on this sheet . There is no dependency among the data block
calculations.
Sub AddFormulas(strtRange As Range)
'find the end of the data
Dim rngStart As Range, rngEnd As Range
Set rngStart = strtRange.Offset(0, strtRange.Column * -1 + 1)
Set rngEnd = rngStart.End(xlDown)
rowStart = Format(rngStart.Row, "#0")
rowend = Format(rngEnd.Row, "#0")
'original code by Rgonzo1971
Range("G" & rowend + 1).Formula = "=COUNT(G" & rowStart & ":G" & rowend & ")"
Range("I" & rowend + 1).Formula = "=AVERAGE(I" & rowStart & ":I" & rowend & ")"
Range("J" & rowend + 1).Formula = "=AVERAGE(J" & rowStart & ":J" & rowend & ")"
Range("L" & rowend + 1).Formula = "=AVERAGE(L" & rowStart & ":L" & rowend & ")"
Range("N" & rowend + 1).Formula = "=AVERAGE(N" & rowStart & ":N" & rowend & ")"
Range("P" & rowend + 1).Formula = "=AVERAGE(P" & rowStart & ":P" & rowend & ")"
Range("J" & rowend + 3).Formula = "=COUNTIF(J" & rowStart & ":J" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("L" & rowend + 3).Formula = "=COUNTIF(L" & rowStart & ":L" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & rowend + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
'---> Disabled formulaR1C1
'Range("K" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
'Range("O" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
'---> Replaced R1C1 and added missing
Range("N" & rowend + 2).Formula = "=(G" & rowend + 1 & "-N" & rowend + 3 & ")/G" & rowend + 1
Range("L" & rowend + 2).Formula = "=(G" & rowend + 1 & "-L" & rowend + 3 & ")/G" & rowend + 1
Range("J" & rowend + 2).Formula = "=(G" & rowend + 1 & "-J" & rowend + 3 & ")/G" & rowend + 1
Range("P" & rowend + 3) = "C"
'---> Format Data
Range(rowend + 1 & ":" & rowend + 3).HorizontalAlignment = xlCenter
Range(rowend + 1 & ":" & rowend + 3).Font.Bold = True
Range("I" & rowend + 1).NumberFormat = "0"
Range("J" & rowend + 1 & ":P" & rowend + 1).NumberFormat = "0.0%;[Red] -0.0%"
Range("J" & rowend + 2 & ":N" & rowend + 2).NumberFormat = "0%"
Range("J" & rowend + 3 & ":N" & rowend + 3).NumberFormat = "[Red]0"
End Sub
Sub AddFormulas(strtRange As Range)
'find the end of the data
Dim rngStart As Range, rngEnd As Range
Set rngStart = strtRange.Offset(0, strtRange.Column * -1 + 1)
Set rngEnd = rngStart.End(xlDown)
rowStart = Format(rngStart.Row, "#0")
rowend = Format(rngEnd.Row, "#0")
'original code by Rgonzo1971
Range("G" & rowend + 1).Formula = "=COUNT(G" & rowStart & ":G" & rowend & ")"
Range("I" & rowend + 1).Formula = "=AVERAGE(I" & rowStart & ":I" & rowend & ")"
Range("J" & rowend + 1).Formula = "=AVERAGE(J" & rowStart & ":J" & rowend & ")"
Range("L" & rowend + 1).Formula = "=AVERAGE(L" & rowStart & ":L" & rowend & ")"
Range("N" & rowend + 1).Formula = "=AVERAGE(N" & rowStart & ":N" & rowend & ")"
Range("P" & rowend + 1).Formula = "=AVERAGE(P" & rowStart & ":P" & rowend & ")"
Range("J" & rowend + 3).Formula = "=COUNTIF(J" & rowStart & ":J" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("L" & rowend + 3).Formula = "=COUNTIF(L" & rowStart & ":L" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & rowend + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
'---> Disabled formulaR1C1
'Range("K" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
'Range("O" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
'---> Replaced R1C1 and added missing
Range("N" & rowend + 2).Formula = "=(G" & rowend + 1 & "-N" & rowend + 3 & ")/G" & rowend + 1
Range("L" & rowend + 2).Formula = "=(G" & rowend + 1 & "-L" & rowend + 3 & ")/G" & rowend + 1
Range("J" & rowend + 2).Formula = "=(G" & rowend + 1 & "-J" & rowend + 3 & ")/G" & rowend + 1
Range("P" & rowend + 3) = "C"
'---> Format Data
Range(rowend + 1 & ":" & rowend + 3).HorizontalAlignment = xlCenter
Range(rowend + 1 & ":" & rowend + 3).Font.Bold = True
Range("I" & rowend + 1).NumberFormat = "0"
Range("J" & rowend + 1 & ":P" & rowend + 1).NumberFormat = "0.0%;[Red] -0.0%"
Range("J" & rowend + 2 & ":N" & rowend + 2).NumberFormat = "0%"
Range("J" & rowend + 3 & ":N" & rowend + 3).NumberFormat = "[Red]0"
End Sub
Sub addspace()
Application.ScreenUpdating = False
Dim lrow As Long, srow As Long
Dim x As Long
srow = 6 '<--- Your Starting Point
Do Until srow > Cells(Cells.Rows.Count, "B").End(xlUp).Row
If Cells(srow - 1, "b").Value = Cells(srow, "b").Value Then
srow = srow + 1
Else
For x = 0 To 3
Rows(srow + x).Insert
Next x
srow = srow + 5
End If
Loop
Application.ScreenUpdating = True
End Sub
Sub AddSummary()
Dim mySel As Range
Set mySel = Application.InputBox(prompt:="Select the first cell of a data block", Title:="Select start", Type:=8)
AddFormulas mySel
End Sub
Sub AddFormulas(strtRange As Range)
'find the end of the data
Dim rngStart As Range, rngEnd As Range
Set rngStart = strtRange.Offset(0, strtRange.Column * -1 + 1)
Set rngEnd = rngStart.End(xlDown)
rowStart = Format(rngStart.Row, "#0")
rowend = Format(rngEnd.Row, "#0")
'original code by Rgonzo1971
Range("G" & rowend + 1).Formula = "=COUNT(G" & rowStart & ":G" & rowend & ")"
Range("I" & rowend + 1).Formula = "=AVERAGE(I" & rowStart & ":I" & rowend & ")"
Range("J" & rowend + 1).Formula = "=AVERAGE(J" & rowStart & ":J" & rowend & ")"
Range("L" & rowend + 1).Formula = "=AVERAGE(L" & rowStart & ":L" & rowend & ")"
Range("N" & rowend + 1).Formula = "=AVERAGE(N" & rowStart & ":N" & rowend & ")"
Range("P" & rowend + 1).Formula = "=AVERAGE(P" & rowStart & ":P" & rowend & ")"
Range("J" & rowend + 3).Formula = "=COUNTIF(J" & rowStart & ":J" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("L" & rowend + 3).Formula = "=COUNTIF(L" & rowStart & ":L" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & rowend + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowend & "," & Chr(34) & "<0" & Chr(34) & ")"
'---> Disabled formulaR1C1
'Range("K" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
'Range("O" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
'---> Replaced R1C1 and added missing
Range("N" & rowend + 2).Formula = "=(G" & rowend + 1 & "-N" & rowend + 3 & ")/G" & rowend + 1
Range("L" & rowend + 2).Formula = "=(G" & rowend + 1 & "-L" & rowend + 3 & ")/G" & rowend + 1
Range("J" & rowend + 2).Formula = "=(G" & rowend + 1 & "-J" & rowend + 3 & ")/G" & rowend + 1
Range("P" & rowend + 3) = "C"
'---> Format Data
Range(rowend + 1 & ":" & rowend + 3).HorizontalAlignment = xlCenter
Range(rowend + 1 & ":" & rowend + 3).Font.Bold = True
Range("I" & rowend + 1).NumberFormat = "0"
Range("J" & rowend + 1 & ":P" & rowend + 1).NumberFormat = "0.0%;[Red] -0.0%"
Range("J" & rowend + 2 & ":N" & rowend + 2).NumberFormat = "0%"
Range("J" & rowend + 3 & ":N" & rowend + 3).NumberFormat = "[Red]0"
End Sub
Opened module 1 and copied the code from post 40468842
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.