PDA

View Full Version : Solved: Insert formulas macro



JimS
07-14-2009, 01:30 PM
I need a macro that will perform the steps below but I’m not sure how to start.

I import several Sheets from another source (there can be 1 – 30 Sheets).
Each sheet’s actual name begins with “Sheet” (ie: Sheet1, Sheet1(2), Sheet1(3), etc).
The data that gets imported on each individual sheet can vary in “width” and “length”.

The columns are grouped in sets of 6, meaning Column B-G is one set of points, H-M (if present) is similar data points to B-G but a different set, N-S (if present) is also similar data points to B-G & H-M but a different set that I need to compare.

Column A is a Timestamp that will exist on each sheet but does not need to be evaluated.

There may only be 1-set of Columns with data (A-G) or there maybe several sets of columns with data.

Here’s what I’m after:

1) Insert 10 rows on every sheet which name begins with “Sheet”. There are other sheets in the workbook but their names do not begin with “Sheet”.

2) Perform the following 3 calculations for every “column used” starting with column B
a. =MAX(B12:Bxxxx) This should be in Cell B1 and get copied out to the last column used.
b. =Average(B12:Bxxxx) This should be in Cell B2 and get copied out to the last column used.
c. =PERCENTILE(B12:Bxxxx, 0.95) This should be in Cell B3 and get copied out to the last column used.
These calculations begin at B12 only if 10 rows get inserted (there is a Header Row [in row 11]).
xxxx can be any number of rows.

When this is all done I will need to create a Table with all the formulas results but I’ll worry about that later.

Thanks for any ideas on how to start.

Jim

mdmackillop
07-14-2009, 01:57 PM
Option Explicit
Sub Test()
Dim sh As Worksheet
Dim Rw As Long, Col As Long
For Each sh In Sheets
With sh
If Left(.Name, 5) = "Sheet" Then
.Rows("1:10").Insert
Col = .Cells(12, Columns.Count).End(xlToLeft).Column
Rw = .Cells(Rows.Count, 2).End(xlUp).Row
.Cells(1, 2).Formula = "=MAX(B12:B" & Rw & ")"
.Cells(2, 2).Formula = "=AVERAGE(B12:B" & Rw & ")"
.Cells(3, 2).Formula = "=PERCENTILE(B12:B" & Rw & ",0.95)"
Range(.Cells(1, 2), .Cells(3, 2)).Resize(, Col - 1).FillRight
End If
End With
Next
End Sub

rbrhodes
07-14-2009, 02:34 PM
Hi JimS,

This should do it.

Notes:

- Uses .Find "*" to find actual last row/column in each sheet.

- Puts formula labels in Col A


Option Explicit
Sub DoStuff()
Dim LastCol As Long
Dim LastRow As Long
Dim sht As Worksheet
'Speed
Application.ScreenUpdating = False

'Do all
For Each sht In Sheets
With sht
'Check name
If Left(.Name, 5) = "Sheet" Then
On Error Resume Next
'Last used Column
LastCol = .Cells.Find(What:="*", After:=.Cells(1, 1), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False).Column
'Insert 10 rows
.Range("A1:A10").EntireRow.Insert
'Last used Row
LastRow = .Cells.Find(What:="*", After:=.Cells(1, 1), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
On Error GoTo 0
'Column A labels
.Cells(1, 1) = "Max:"
.Cells(2, 1) = "Average:"
.Cells(3, 1) = "Percentile (.95):"
'Column B formulas
.Cells(1, 2) = "=MAX(B12:B" & LastRow & ")"
.Cells(2, 2) = "=Average(B12:B" & LastRow & ")"
.Cells(3, 2) = "=Percentile(B12:B" & LastRow & ", 0.95)"
.Range("B1:B3").Copy .Range(Cells(1, 3).Address, Cells(3, LastCol).Address)
End If
End With
LastRow = 0
LastCol = 0
Next sht

'Cleanup
Set sht = Nothing
'Reset
Application.ScreenUpdating = True

End Sub

JimS
07-15-2009, 05:33 AM
You both are AMAZING!!!

Thank you so much.

mdmackillop, It failed when trying to FillRight. I think it has something to do with the sheet not being active (maybe)???

dr's works for me.

Thanks again - both of you...

Jim

mdmackillop
07-15-2009, 05:58 AM
I missed a "." before the second "Cells" in this line,
try

Range(.Cells(1, 2), .Cells(3, 2)).Resize(, Col - 1).FillRight