#1   Report Post  
Posted to microsoft.public.excel.misc
smorgan
 
Posts: n/a
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Search, Copy, Paste Macro in Excel [email protected] Excel Worksheet Functions 0 January 3rd 06 06:51 PM
Closing File Error jcliquidtension Excel Discussion (Misc queries) 4 October 20th 05 12:22 PM
macro with F9 Kenny Excel Discussion (Misc queries) 1 August 3rd 05 02:41 PM
Make Alignment options under format cells available as shortcut dforrest Excel Discussion (Misc queries) 1 July 14th 05 10:58 PM
Playing a macro from another workbook Jim Excel Discussion (Misc queries) 1 February 23rd 05 10:12 PM


All times are GMT +1. The time now is 12:49 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"