Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Sub Macro3()
For Idx = 1 To 3 Step 2
Set OrigSht = Sheets("Sheet" & Idx)
Set DestSht = Sheets("Sheet" & Idx + 1)
DestSht.Cells.Delete
OrigSht.Cells.Copy Destination:=DestSht.Range("A1")
DestSht.Activate
Range("A1") = "Sheet " & Idx + 1
LastRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
myRow = LastRow
While myRow <> 1
Range("G" & myRow + 1).Formula = "=COUNT(G" & Range("A" & myRow).End(xlUp).Row & ":G" & myRow & ")"
Range("I" & myRow + 1).Formula = "=AVERAGE(I" & Range("A" & myRow).End(xlUp).Row & ":I" & myRow & ")"
Range("J" & myRow + 1).Formula = "=AVERAGE(J" & Range("A" & myRow).End(xlUp).Row & ":J" & myRow & ")"
Range("L" & myRow + 1).Formula = "=AVERAGE(L" & Range("A" & myRow).End(xlUp).Row & ":L" & myRow & ")"
Range("N" & myRow + 1).Formula = "=AVERAGE(N" & Range("A" & myRow).End(xlUp).Row & ":N" & myRow & ")"
Range("P" & myRow + 1).Formula = "=AVERAGE(P" & Range("A" & myRow).End(xlUp).Row & ":P" & myRow & ")"
Range("J" & myRow + 3).Formula = "=COUNTIF(J" & Range("A" & myRow).End(xlUp).Row & ":J" & myRow & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & myRow + 3).Formula = "=COUNTIF(N" & Range("A" & myRow).End(xlUp).Row & ":N" & myRow & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("K" & myRow + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
Range("O" & myRow + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
myRow = Range("A" & myRow).End(xlUp).End(xlUp).Row
Wend
Next
End Sub
Regards
Sub Macro3()
For Idx = 1 To 3 Step 2
Set OrigSht = Sheets("Sheet" & Idx)
Set DestSht = Sheets("Sheet" & Idx + 1)
DestSht.Cells.Delete
OrigSht.Cells.Copy Destination:=DestSht.Range("A1")
DestSht.Activate
Range("A1") = "Sheet " & Idx + 1
LastRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
myRow = LastRow
While myRow <> 1
Range("G" & myRow + 1).Formula = "=COUNT(G" & Range("A" & myRow).End(xlUp).Row & ":G" & myRow & ")"
Range("I" & myRow + 1).Formula = "=AVERAGE(I" & Range("A" & myRow).End(xlUp).Row & ":I" & myRow & ")"
Range("J" & myRow + 1).Formula = "=AVERAGE(J" & Range("A" & myRow).End(xlUp).Row & ":J" & myRow & ")"
Range("L" & myRow + 1).Formula = "=AVERAGE(L" & Range("A" & myRow).End(xlUp).Row & ":L" & myRow & ")"
Range("N" & myRow + 1).Formula = "=AVERAGE(N" & Range("A" & myRow).End(xlUp).Row & ":N" & myRow & ")"
Range("P" & myRow + 1).Formula = "=AVERAGE(P" & Range("A" & myRow).End(xlUp).Row & ":P" & myRow & ")"
Range("J" & myRow + 3).Formula = "=COUNTIF(J" & Range("A" & myRow).End(xlUp).Row & ":J" & myRow & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & myRow + 3).Formula = "=COUNTIF(N" & Range("A" & myRow).End(xlUp).Row & ":N" & myRow & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("K" & myRow + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
Range("O" & myRow + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
myRow = Range("A" & myRow).End(xlUp).End(xlUp).Row
Wend
Next
End Sub
1. Place the cursor at G15 .... starting point for the macro
2. Calculate the COUNT MUMBERS from G4 to G14 range
3. Move the cursor to I15
4. Calculate the AVERAGE from I4 to I14 range
5. Move the cursor to J15
6. Calculate the AVERAGE from J4 to J14 range
'update by Robberbaron @ EE Feb 2013
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("N" & rowEnd + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowEnd & "," & Chr(34) & "<0" & Chr(34) & ")"
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]"
End Sub
'update by Robberbaron @ EE Feb 2013
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("N" & rowEnd + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowEnd & "," & Chr(34) & "<0" & Chr(34) & ")"
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]"
End Sub
'original formaula code by Rgonzo1971
Range("G" & rowEnd + 1).Formula = "=COUNT(G" & rowStart & ":G" & rowEnd & ")"
Range("G" & rowEnd + 1).NumberFormat = "0"
FormatBlack Range("G" & rowEnd + 1)
Range("I" & rowEnd + 1).Formula = "=AVERAGE(I" & rowStart & ":I" & rowEnd & ")"
Range("I" & rowEnd + 1).NumberFormat = "0"
FormatBlack Range("I" & rowEnd + 1)
Range("J" & rowEnd + 1).Formula = "=AVERAGE(J" & rowStart & ":J" & rowEnd & ")"
Range("J" & rowEnd + 1).NumberFormat = "0.0%"
FormatBlack Range("J" & rowEnd + 1)
Range("L" & rowEnd + 1).Formula = "=AVERAGE(L" & rowStart & ":L" & rowEnd & ")"
Range("L" & rowEnd + 1).NumberFormat = "0.0%"
FormatBlack Range("L" & rowEnd + 1)
Range("N" & rowEnd + 1).Formula = "=AVERAGE(N" & rowStart & ":N" & rowEnd & ")"
Range("N" & rowEnd + 1).NumberFormat = "0.0%"
FormatBlack Range("N" & rowEnd + 1)
Range("P" & rowEnd + 1).Formula = "=AVERAGE(P" & rowStart & ":P" & rowEnd & ")"
Range("P" & rowEnd + 1).NumberFormat = "0.0%"
FormatRed Range("P" & rowEnd + 1)
Range("J" & rowEnd + 3).Formula = "=COUNTIF(J" & rowStart & ":J" & rowEnd & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("J" & rowEnd + 3).NumberFormat = "0"
FormatRed Range("J" & rowEnd + 3)
Range("N" & rowEnd + 3).Formula = "=COUNTIF(N" & rowStart & ":N" & rowEnd & "," & Chr(34) & "<0" & Chr(34) & ")"
Range("N" & rowEnd + 3).NumberFormat = "0"
FormatRed Range("N" & rowEnd + 3)
Range("K" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-4]-R[1]C[-1])/R[-1]C[-4]"
Range("K" & rowEnd + 2).NumberFormat = "0.0%"
FormatBlack Range("K" & rowEnd + 2)
Range("O" & rowEnd + 2).FormulaR1C1 = "=(R[-1]C[-8]-R[1]C[-1])/R[-1]C[-8]"
Range("O" & rowEnd + 1).NumberFormat = "0.0%"
FormatBlack Range("O" & rowEnd + 2)
End Sub
Sub FormatRed(rng As Range)
With rng.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = -16776961
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
Sub FormatBlack(rng As Range)
With rng.Font
.Name = "Arial"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End Sub
SUPER-MACRO4.xlsm
If you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.