Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Macro help
I'm new to Macros and this forum, so any help is greatly appreciated. I'm trying to run a macro on my machine (Windows 2000 and Office 2003) and I keep getting an error on one method. Now I tried to run the same macro on a different machine (Windows XP and Office 2003) and it didn't error out. Below is the macro and the text in red is where it's erroring out. Please help a newbie out. Thanks Stephanie Public strControlTitle As String Public strControlTime As String Public strControlUnit As String Public intControlItem As Integer Public intLastNameOnly As Integer Public intDataType As Integer Sub Main() Dim strControlItem, strPageName, strValue, sigma, z95, z99 As String Dim r, c, count, cmax, rmax, rt, ct, low, high, a, b As Integer Dim lesscol As Integer With ControlChartForm .ComboBox1.AddItem ("Average Turn Around Time All Patients") .ComboBox1.AddItem ("Average Turn Around Time Discharged Patients") .ComboBox1.AddItem ("Average Turn Around Time Admitted Patients") .ComboBox1.AddItem ("Charges Per Hour") .ComboBox1.AddItem ("Admission Percentage") .ComboBox2.AddItem ("Average TAT (in minutes)") .ComboBox2.AddItem ("Charges (in dollars)") .ComboBox2.AddItem ("Admissons %") End With Load ControlChartForm ControlChartForm.Show If intControlItem = 1 Then strControlItem = "Physician" Else strControlItem = "Physician" If Range("A1").CurrentRegion.Columns.count = 2 Then ActiveSheet.Range("A:A").Insert (xlShiftToRight) Range("A1").Value = "All Hospitals" End If End If ActiveSheet.Name = "Raw Data" If InStr(Range("A2").Value, "---") 0 Then _ ActiveSheet.Rows(2).Delete Worksheets.Add.Move after:=Worksheets("Raw Data") Worksheets(Worksheets.count).Name = "Chart Data" With Columns(1) .WrapText = True .VerticalAlignment = xlVAlignCenter .HorizontalAlignment = xlHAlignCenter End With Worksheets("Raw Data").Activate Range("a1").CurrentRegion.Select With Selection .Replace _ What:="Muhlenberg Reg.", _ Replacement:="MUHLENBERG REGIONAL" .Replace _ What:="Israel Med.", _ Replacement:="ISRAEL MEDICAL" .Replace _ What:="RW Johnson", _ Replacement:="ROBERT WOOD JOHNSON" '************************************************* 'Add known spelling or formatting errors in the space below 'Use the following format: ' ' .Replace _ ' What:="Text to replace" ' With:="Replacement text" '************************************************* End With ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _ Selection, TableDestination:=Worksheets("Chart Data").Range("a1"), TableName:="ChartData", RowGrand:=True ActiveSheet.PivotTables("ChartData").AddFields RowFields:=Worksheets("Raw Data").Range("a1").Text, ColumnFields:=Worksheets("Raw Data").Range("b1").Text addtotable = True If intDataType = 0 Then With ActiveSheet.PivotTables("ChartData").PivotFields(3 ) .Orientation = xlDataField .Name = "Admissions %" .Position = 1 .Function = xlAverage End With With ActiveSheet.PivotTables("ChartData").PivotFields(3 ) .Orientation = xlDataField .Name = "Patients Seen" .Position = 2 .Function = xlCount End With Else With ActiveSheet.PivotTables("ChartData").PivotFields(3 ) .Orientation = xlDataField .Name = "Count of " & strValue .Position = 1 .Function = xlCount End With With ActiveSheet.PivotTables("ChartData").PivotFields(3 ) .Orientation = xlDataField .Name = "Average of " & strValue .Position = 2 .Function = xlAverage End With With ActiveSheet.PivotTables("ChartData").PivotFields(3 ) .Orientation = xlDataField .Name = "StdDev of " & strValue .Position = 3 .Function = xlStDev End With End If r = 3 c = 3 cmax = ActiveSheet.PivotTables("ChartData").ColumnFields( 1).PivotItems.count rmax = ActiveSheet.PivotTables("ChartData").RowFields(1). PivotItems.count + 1 rt = (2 + intDataType) * (rmax + 3) ct = 3 For i = 1 To rmax ct = 3 Worksheets("Chart Data").Activate Range(Cells(rt, 1), Cells(rt + 7, 1)).Merge If Trim(Cells(r, 1).Value) = "Total Count of" Then Cells(rt, 1).Value = "Overall Score" Else Cells(rt, 1).Formula = Cells(r, 1).Value End If Cells(rt + 1, 2).Formula = "UCL 99%" Cells(rt + 2, 2).Formula = "UCL 95%" Cells(rt + 3, 2).Formula = strControlItem & " Mean" Cells(rt + 4, 2).Formula = "Overall Mean" Cells(rt + 5, 2).Formula = "LCL 95%" Cells(rt + 6, 2).Formula = "LCL 99%" Cells(rt + 7, 2).Formula = "Count" strPageName = Cells(r, 1).Value For c = 3 To cmax + 2 'Must be greater than 5 surveys If Cells(r, c).Value = 5 Then Cells(rt, ct).Value = Cells(2, c).Value Else End If If Cells(r, c).Value < 5 Then lesscol = lesscol + 1 GoTo Jumper End If If intDataType = 0 Then Cells(rt + 7, ct).FormulaR1C1 = "=R" & r + 1 & "C" & c z95 = "normsinv(.975)*" z99 = "normsinv(.995)*" If Cells(rt + 7, ct).Value 3 Then Cells(rt + 1, ct).FormulaR1C1 = "=R[" & 3 & "]C[0]+" & z99 & "sqrt(R[" & 2 & "]C[0]*(1-R[" & 2 & "]C[0])/R[" & 6 & "]C[0])" Cells(rt + 2, ct).FormulaR1C1 = "=R[" & 2 & "]C[0]+" & z95 & "sqrt(R[" & 1 & "]C[0]*(1-R[" & 1 & "]C[0])/R[" & 5 & "]C[0])" Cells(rt + 4, ct).FormulaR1C1 = "=R" & r + 1 & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotIt ems.count + 3 Cells(rt + 5, ct).FormulaR1C1 = "=R[" & -1 & "]C[0]-" & z95 & "sqrt(R[" & -2 & "]C[0]*(1-R[" & -2 & "]C[0])/R[" & 2 & "]C[0])" Cells(rt + 6, ct).FormulaR1C1 = "=R[" & -2 & "]C[0]-" & z99 & "sqrt(R[" & -3 & "]C[0]*(1-R[" & -3 & "]C[0])/R[" & 1 & "]C[0])" End If Cells(rt + 3, ct).FormulaR1C1 = "=R" & r & "C" & c Cells(rt + 4, ct).FormulaR1C1 = "=R" & r & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotIt ems.count + 3 Else Cells(rt + 7, ct).FormulaR1C1 = "=R" & r & "C" & c sigma = "(R" & r + 2 & "C" & c & ")" If Cells(rt + 7, ct).Value 4 Then Cells(rt + 1, ct).FormulaR1C1 = "=R[3]C[0]+ tinv(.01,R[6]C[0])*" & sigma & "/sqrt(R[6]C[0])" Cells(rt + 2, ct).FormulaR1C1 = "=R[2]C[0]+ tinv(.05,R[5]C[0])*" & sigma & "/sqrt(R[5]C[0])" Cells(rt + 4, ct).FormulaR1C1 = "=R" & r & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotIt ems.count + 3 Cells(rt + 5, ct).FormulaR1C1 = "=R[-1]C[0]- tinv(.05,R[2]C[0])*" & sigma & "/sqrt(R[2]C[0])" Cells(rt + 6, ct).FormulaR1C1 = "=R[-2]C[0]- tinv(.01,R[1]C[0])*" & sigma & "/sqrt(R[1]C[0])" End If Cells(rt + 3, ct).FormulaR1C1 = "=R" & r + 1 & "C" & c Cells(rt + 4, ct).FormulaR1C1 = "=R" & r + 1 & "C" & ActiveSheet.PivotTables(1).ColumnFields(1).PivotIt ems.count + 3 End If Jumper: ct = ct + 1 Next c low = Application.WorksheetFunction.Min(Range(Cells(rt + 6, ct - 1), Cells(rt + 1, 3))) low = Application.WorksheetFunction.RoundDown(low + 0, 0) high = Application.WorksheetFunction.Max(Range(Cells(rt + 6, ct - 1), Cells(rt + 1, 3))) high = Application.WorksheetFunction.RoundUp(high + 0, 0) ActiveSheet.Range(Cells(rt + 7, ct - 1), Cells(rt, 3)).Select Selection.Sort Key1:=Cells(rt + 7, 3), Order1:=xlAscending, _ Orientation:=xlLeftToRight Worksheets("Chart Data").Range(Cells(rt, 2), Cells(rt + 6, ct - 1 - lesscol)).Select Charts.Add With ActiveChart .ApplyCustomType ChartType:=xlUserDefined, TypeName:= _ "Control Chart" .Location xlLocationAsNewSheet, i & "." & Left(strPageName, 7) .Move after:=Charts(Charts.count) .HasTitle = True If intControlItem = 1 Then .ChartTitle.Characters.Text = strControlTitle & Chr(13) & "Medical Staff Survey Results For:" & StrConv(strPageName, vbProperCase) & Chr(13) & strControlTime & Chr(13) & LCase$("minimum of 5 results required") Else .ChartTitle.Characters.Text = strControlTitle & Chr(13) & "Medical Staff Survey Results For:" & StrConv(strPageName, vbProperCase) & Chr(13) & strControlTime & Chr(13) & LCase$("minimum of 5 results required") End If .SeriesCollection(3).DataLabels.Font.Background = xlTransparent If intDataType = 0 Then _ .SeriesCollection(3).DataLabels.NumberFormat = "0.0%" With .Axes(xlCategory) .HasTitle = False .MajorTickMark = xlTickMarkOutside .TickLabelPosition = xlTickLabelPositionLow .TickLabels.Orientation = 90 End With With .Axes(xlValue) .HasTitle = True .AxisTitle.Characters.Text = strControlUnit If intDataType = 0 Then .MinimumScaleIsAuto = True .MaximumScaleIsAuto = True .TickLabels.NumberFormat = "0.0%" Else .MinimumScale = low .MaximumScale = high End If End With End With rt = rt + 9 r = r + intDataType + 2 lesscol = 0 Next i End Sub -- smorgan ------------------------------------------------------------------------ smorgan's Profile: http://www.excelforum.com/member.php...o&userid=35829 View this thread: http://www.excelforum.com/showthread...hreadid=556595 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Search, Copy, Paste Macro in Excel | Excel Worksheet Functions | |||
Closing File Error | Excel Discussion (Misc queries) | |||
macro with F9 | Excel Discussion (Misc queries) | |||
Make Alignment options under format cells available as shortcut | Excel Discussion (Misc queries) | |||
Playing a macro from another workbook | Excel Discussion (Misc queries) |