S
smorgan
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 sam
macro on a different machine (Windows XP and Office 2003) and it didn'
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 Discharge
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").AddField
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).PivotItems.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).PivotItems.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).PivotItems.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).PivotItems.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
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 sam
macro on a different machine (Windows XP and Office 2003) and it didn'
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 Discharge
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").AddField
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).PivotItems.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).PivotItems.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).PivotItems.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).PivotItems.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