Consulting

Results 1 to 4 of 4

Thread: Critical Thinking Challenge

  1. #1

    Exclamation Critical Thinking Challenge

    Hi all,

    I work at a hospital and we are trying to update our physician profiles process. Physician profiles are like each physician's report card that the hospital keeps track of. As of right now, data gets mailed, emailed, scribbled on scraps of paper and sent to one person who gets to enter it all in and do a mail merge. Pretty ancient, I know.

    I've written a VBA program to try and update everything automatically. My program currently does the following:
    • imports a list of active doctors for a specific department into a spreadsheet from an Access database along with basic information like licensure, insurance, etc. each of these fields are put into an array
    • asks the user to enter the current year
    • creates a new Excel file for that department and that year; each doctor from the list of active doctors is given their own tab in the Excel file and the tabs are named after the doctors
    • the profile template is then copied from another excel file into each doctor's worksheet
    • the program loops through the arrays, copying and pasting the insurance information, licensure information, etc. (Doctor 1 = worksheet 1 = the first entry of every array)
    • the program then compiles several spreadsheets into one spreadsheet. these spreadsheets are where several individuals report their numbers. they are in separate spreadsheets so that confidential data is only known to those who need to know it. the program takes this data and puts it into arrays
    • the program then loops through the arrays, copying and pasting the information into each doctor's excel file
    The program runs and works well; however, it does not account for a few things:
    • If a doctor leaves the institution, their name will not show up from the Access database because they are no longer active. So if the program is run during the middle of the year when we already have a file for that year, the file is overwritten, and any new doctors will be added but any doctors that have left will disappear. We need to keep their information for the time that they were at our institution, and all of this information would be lost.
    • Secondly, since all the data is put into arrays, the program copies the information, rather than links it. It would be very helpful if the program linked all the information so it would automatically update. However, the number of active doctors will vary so I don't know how to link without it being attached to a specific doctor/file.
    I'd really appreciate ANY insight that you may have. I'm new to VBA and programming and have been teaching myself. I'll attach my code below though be warned, it is a little lengthy.

    [vba]
    Dim i As Integer
    Dim tabName As String
    Dim wk As Workbook
    Dim awk As Workbook
    Dim DocListName As Variant
    Dim DocFirstLast As Variant
    Dim year As String
    Dim num_DocListName As Integer
    Dim objSheet As Worksheet
    Dim StatusName As Variant
    Dim NYSLic As Variant
    Dim Boards As Variant
    Dim DEA As Variant
    Dim MalPrac As Variant
    Dim nxt_reappt_dt As Variant
    Dim LastRow As Long
    Dim Individual_Data As Workbook
    Dim Peer_Review_Num_Cases_QTR1 As Variant
    Dim Aspir_Pneumonia_QTR1 As Variant
    Dim CNS_Complications_QTR1 As Variant
    Dim Dental_Trauma_QTR1 As Variant
    Dim MI_48hrs_QTR1 As Variant
    Dim Ocular_Trauma_QTR1 As Variant
    Dim Periph_Neuro_Def_QTR1 As Variant
    Dim Post_LP_Headache_QTR1 As Variant
    Dim Respiratory_Arrests_QTR1 As Variant
    Dim Unplanned_ICU_QTR1 As Variant
    Dim Other_Complications_QTR1 As Variant
    Dim Num_ReIntubations_QTR1 As Variant
    Dim FocusedReview_PerformIssues_QTR1 As Variant
    Dim PatientComplaint_QTR1 As Variant
    Dim HospitalStaffComplaint_QTR1 As Variant
    Dim FamilyComplaint_QTR1 As Variant
    Dim MedicalStaffComplaint_QTR1 As Variant
    Dim HCAHPS_QTR1 As Variant
    Dim PG_QTR1 As Variant
    Dim Peer_Review_Num_Cases_QTR2 As Variant
    Dim Aspir_Pneumonia_QTR2 As Variant
    Dim CNS_Complications_QTR2 As Variant
    Dim Dental_Trauma_QTR2 As Variant
    Dim MI_48hrs_QTR2 As Variant
    Dim Ocular_Trauma_QTR2 As Variant
    Dim Periph_Neuro_Def_QTR2 As Variant
    Dim Post_LP_Headache_QTR2 As Variant
    Dim Respiratory_Arrests_QTR2 As Variant
    Dim Unplanned_ICU_QTR2 As Variant
    Dim Other_Complications_QTR2 As Variant
    Dim Num_ReIntubations_QTR2 As Variant
    Dim FocusedReview_PerformIssues_QTR2 As Variant
    Dim PatientComplaint_QTR2 As Variant
    Dim HospitalStaffComplaint_QTR2 As Variant
    Dim FamilyComplaint_QTR2 As Variant
    Dim MedicalStaffComplaint_QTR2 As Variant
    Dim HCAHPS_QTR2 As Variant
    Dim PG_QTR2 As Variant
    Dim Peer_Review_Num_Cases_QTR3 As Variant
    Dim Aspir_Pneumonia_QTR3 As Variant
    Dim CNS_Complications_QTR3 As Variant
    Dim Dental_Trauma_QTR3 As Variant
    Dim MI_48hrs_QTR3 As Variant
    Dim Ocular_Trauma_QTR3 As Variant
    Dim Periph_Neuro_Def_QTR3 As Variant
    Dim Post_LP_Headache_QTR3 As Variant
    Dim Respiratory_Arrests_QTR3 As Variant
    Dim Unplanned_ICU_QTR3 As Variant
    Dim Other_Complications_QTR3 As Variant
    Dim Num_ReIntubations_QTR3 As Variant
    Dim FocusedReview_PerformIssues_QTR3 As Variant
    Dim PatientComplaint_QTR3 As Variant
    Dim HospitalStaffComplaint_QTR3 As Variant
    Dim FamilyComplaint_QTR3 As Variant
    Dim MedicalStaffComplaint_QTR3 As Variant
    Dim HCAHPS_QTR3 As Variant
    Dim PG_QTR3 As Variant
    Dim Peer_Review_Num_Cases_QTR4 As Variant
    Dim Aspir_Pneumonia_QTR4 As Variant
    Dim CNS_Complications_QTR4 As Variant
    Dim Dental_Trauma_QTR4 As Variant
    Dim MI_48hrs_QTR4 As Variant
    Dim Ocular_Trauma_QTR4 As Variant
    Dim Periph_Neuro_Def_QTR4 As Variant
    Dim Post_LP_Headache_QTR4 As Variant
    Dim Respiratory_Arrests_QTR4 As Variant
    Dim Unplanned_ICU_QTR4 As Variant
    Dim Other_Complications_QTR4 As Variant
    Dim Num_ReIntubations_QTR4 As Variant
    Dim FocusedReview_PerformIssues_QTR4 As Variant
    Dim PatientComplaint_QTR4 As Variant
    Dim HospitalStaffComplaint_QTR4 As Variant
    Dim FamilyComplaint_QTR4 As Variant
    Dim MedicalStaffComplaint_QTR4 As Variant
    Dim HCAHPS_QTR4 As Variant
    Dim PG_QTR4 As Variant
    Dim NosocomialInfections_QTR1 As Variant
    Dim NosocomialInfections_QTR2 As Variant
    Dim NosocomialInfections_QTR3 As Variant
    Dim NosocomialInfections_QTR4 As Variant
    Dim HIM_Suspension_QTR1 As Variant
    Dim HIM_Suspension_QTR2 As Variant
    Dim HIM_Suspension_QTR3 As Variant
    Dim HIM_Suspension_QTR4 As Variant
    Dim Meeting_Attendance_QTR1 As Variant
    Dim Meeting_Attendance_QTR2 As Variant
    Dim Meeting_Attendance_QTR3 As Variant
    Dim Meeting_Attendance_QTR4 As Variant
    Dim Drug_Utilization_QTR1 As Variant
    Dim Illegible_Handwriting_QTR1 As Variant
    Dim Unsafe_Abbreviations_QTR1 As Variant
    Dim PRNs_QTR1 As Variant
    Dim Drug_Utilization_QTR2 As Variant
    Dim Illegible_Handwriting_QTR2 As Variant
    Dim Unsafe_Abbreviations_QTR2 As Variant
    Dim PRNs_QTR2 As Variant
    Dim Drug_Utilization_QTR3 As Variant
    Dim Illegible_Handwriting_QTR3 As Variant
    Dim Unsafe_Abbreviations_QTR3 As Variant
    Dim PRNs_QTR3 As Variant
    Dim Drug_Utilization_QTR4 As Variant
    Dim Illegible_Handwriting_QTR4 As Variant
    Dim Unsafe_Abbreviations_QTR4 As Variant
    Dim PRNs_QTR4 As Variant
    Dim NYPORTS_QTR1 As Variant
    Dim PRO_QTR1 As Variant
    Dim DOH_QTR1 As Variant
    Dim Blood_Utilization_QTR1 As Variant
    Dim NYPORTS_QTR2 As Variant
    Dim PRO_QTR2 As Variant
    Dim DOH_QTR2 As Variant
    Dim Blood_Utilization_QTR2 As Variant
    Dim NYPORTS_QTR3 As Variant
    Dim PRO_QTR3 As Variant
    Dim DOH_QTR3 As Variant
    Dim Blood_Utilization_QTR3 As Variant
    Dim NYPORTS_QTR4 As Variant
    Dim PRO_QTR4 As Variant
    Dim DOH_QTR4 As Variant
    Dim Blood_Utilization_QTR4 As Variant
    Dim Focus_Peer_Review_QTR1 As Variant
    Dim Focus_Peer_Review_QTR2 As Variant
    Dim Focus_Peer_Review_QTR3 As Variant
    Dim Focus_Peer_Review_QTR4 As Variant

    Public Sub RunProfiles_Anesthesia()

    ' RunProfiles_Anesthesia:
    ' Updates Anesthesia Practitioner Profiles
    ' Makes "Anesthesia" sheet the active sheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\TEST\CredData.xls")
    Sheets("Anesthesia").Activate
    ' Refresh the data
    ActiveSheet.Range("A1").Select
    Selection.QueryTable.Refresh BackgroundQuery:=False
    ' Finds the last row of the column
    LastRow = Cells(Rows.Count, "B").End(xlUp).Row
    ' Turns off alerts
    Application.DisplayAlerts = False
    ' Imports JBK's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\BK,J.xls")
    awk.Sheets("Anesthesia").Range("B3", "BZ" & LastRow + 3).Copy
    Set Individual_Data = Workbooks.Open("E:\Practitioner Profiling\TEST\Individual Data.xls")
    Individual_Data.Sheets("Anesthesia").Activate
    Range("A1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects the number of peer review cases for quarter one
    Peer_Review_Num_Cases_QTR1 = Range("B3", "B" & LastRow + 1).Value
    ' Selects the number of aspir. pneumonia for quarter one
    Aspir_Pneumonia_QTR1 = Range("C3", "C" & LastRow + 1).Value
    ' Selects CNS Complications for quarter one
    CNS_Complications_QTR1 = Range("D3", "D" & LastRow + 1).Value
    ' Selects Dental Trauma for quarter one
    Dental_Trauma_QTR1 = Range("E3", "E" & LastRow + 1).Value
    ' Selects MI within 48 hours for quarter one
    MI_48hrs_QTR1 = Range("F3", "F" & LastRow + 1).Value
    ' Selects Ocular Trauma for quarter one
    Ocular_Trauma_QTR1 = Range("G3", "G" & LastRow + 1).Value
    ' Selects Periph. Neuro Def. for quarter one
    Periph_Neuro_Def_QTR1 = Range("H3", "H" & LastRow + 1).Value
    ' Selects Post-LP Headache for quarter one
    Post_LP_Headache_QTR1 = Range("I3", "I" & LastRow + 1).Value
    ' Selects Respiratory Arrests for quarter one
    Respiratory_Arrests_QTR1 = Range("J3", "J" & LastRow + 1).Value
    ' Selects Unplanned ICU within 24 hours of anesthesia for quarter one
    Unplanned_ICU_QTR1 = Range("K3", "K" & LastRow + 1).Value
    ' Selects Other Complications for quarter one
    Other_Complications_QTR1 = Range("L3", "L" & LastRow + 1).Value
    ' Selects Number of Re-Intubations for quarter one
    Num_ReIntubations_QTR1 = Range("M3", "M" & LastRow + 1).Value
    ' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter one
    FocusedReview_PerformIssues_QTR1 = Range("N3", "N" & LastRow + 1).Value
    ' Selects Patient COmplaint/Concern/Grievance for quarter one
    PatientComplaint_QTR1 = Range("O3", "O" & LastRow + 1).Value
    ' Selects Hospital Staff Complaint/Concerns for quarter one
    HospitalStaffComplaint_QTR1 = Range("P3", "P" & LastRow + 1).Value
    ' Selects Family Complaint/Concern/Grievance for quarter one
    FamilyComplaint_QTR1 = Range("Q3", "Q" & LastRow + 1).Value
    ' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter one
    MedicalStaffComplaint_QTR1 = Range("R3", "R" & LastRow + 1).Value
    ' Selects HCAHPS Physician Rate for quarter one
    HCAHPS_QTR1 = Range("S3", "S" & LastRow + 1).Value
    ' Selects Press Ganey Customer Satisfaction for quarter one
    PG_QTR1 = Range("T3", "T" & LastRow + 1).Value
    ' Selects the number of peer review cases for quarter two
    Peer_Review_Num_Cases_QTR2 = Range("U3", "U" & LastRow + 1).Value
    ' Selects the number of aspir. pneumonia for quarter two
    Aspir_Pneumonia_QTR2 = Range("V3", "V" & LastRow + 1).Value
    ' Selects CNS Complications for quarter two
    CNS_Complications_QTR2 = Range("W3", "W" & LastRow + 1).Value
    ' Selects Dental Trauma for quarter two
    Dental_Trauma_QTR2 = Range("X3", "X" & LastRow + 1).Value
    ' Selects MI within 48 hours for quarter two
    MI_48hrs_QTR2 = Range("Y3", "Y" & LastRow + 1).Value
    ' Selects Ocular Trauma for quarter two
    Ocular_Trauma_QTR2 = Range("Z3", "Z" & LastRow + 1).Value
    ' Selects Periph. Neuro Def. for quarter two
    Periph_Neuro_Def_QTR2 = Range("AA3", "AA" & LastRow + 1).Value
    ' Selects Post-LP Headache for quarter two
    Post_LP_Headache_QTR2 = Range("AB3", "AB" & LastRow + 1).Value
    ' Selects Respiratory Arrests for quarter two
    Respiratory_Arrests_QTR2 = Range("AC3", "AC" & LastRow + 1).Value
    ' Selects Unplanned ICU within 24 hours of anesthesia for quarter two
    Unplanned_ICU_QTR2 = Range("AD3", "AD" & LastRow + 1).Value
    ' Selects Other Complications for quarter two
    Other_Complications_QTR2 = Range("AE3", "AE" & LastRow + 1).Value
    ' Selects Number of Re-Intubations for quarter two
    Num_ReIntubations_QTR2 = Range("AF3", "AF" & LastRow + 1).Value
    ' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter two
    FocusedReview_PerformIssues_QTR2 = Range("AG3", "AG" & LastRow + 1).Value
    ' Selects Patient COmplaint/Concern/Grievance for quarter two
    PatientComplaint_QTR2 = Range("AH3", "AH" & LastRow + 1).Value
    ' Selects Hospital Staff Complaint/Concerns for quarter two
    HospitalStaffComplaint_QTR2 = Range("AI3", "AI" & LastRow + 1).Value
    ' Selects Family Complaint/Concern/Grievance for quarter two
    FamilyComplaint_QTR2 = Range("AJ3", "AJ" & LastRow + 1).Value
    ' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter two
    MedicalStaffComplaint_QTR2 = Range("AK3", "AK" & LastRow + 1).Value
    ' Selects HCAHPS Physician Rate for quarter two
    HCAHPS_QTR2 = Range("AL3", "AL" & LastRow + 1).Value
    ' Selects Press Ganey Customer Satisfaction for quarter two
    PG_QTR2 = Range("AM3", "AM" & LastRow + 1).Value
    ' Selects the number of peer review cases for quarter three
    Peer_Review_Num_Cases_QTR3 = Range("AN3", "AN" & LastRow + 1).Value
    ' Selects the number of aspir. pneumonia for quarter three
    Aspir_Pneumonia_QTR3 = Range("AO3", "AO" & LastRow + 1).Value
    ' Selects CNS Complications for quarter three
    CNS_Complications_QTR3 = Range("AP3", "AP" & LastRow + 1).Value
    ' Selects Dental Trauma for quarter three
    Dental_Trauma_QTR3 = Range("AQ3", "AQ" & LastRow + 1).Value
    ' Selects MI within 48 hours for quarter three
    MI_48hrs_QTR3 = Range("AR3", "AR" & LastRow + 1).Value
    ' Selects Ocular Trauma for quarter three
    Ocular_Trauma_QTR3 = Range("AS3", "AS" & LastRow + 1).Value
    ' Selects Periph. Neuro Def. for quarter three
    Periph_Neuro_Def_QTR3 = Range("AT3", "AT" & LastRow + 1).Value
    ' Selects Post-LP Headache for quarter three
    Post_LP_Headache_QTR3 = Range("AU3", "AU" & LastRow + 1).Value
    ' Selects Respiratory Arrests for quarter three
    Respiratory_Arrests_QTR3 = Range("AV3", "AV" & LastRow + 1).Value
    ' Selects Unplanned ICU within 24 hours of anesthesia for quarter three
    Unplanned_ICU_QTR3 = Range("AW3", "AW" & LastRow + 1).Value
    ' Selects Other Complications for quarter three
    Other_Complications_QTR3 = Range("AX3", "AX" & LastRow + 1).Value
    ' Selects Number of Re-Intubations for quarter three
    Num_ReIntubations_QTR3 = Range("AY3", "AY" & LastRow + 1).Value
    ' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter three
    FocusedReview_PerformIssues_QTR3 = Range("AZ3", "AZ" & LastRow + 1).Value
    ' Selects Patient COmplaint/Concern/Grievance for quarter three
    PatientComplaint_QTR3 = Range("BA3", "BA" & LastRow + 1).Value
    ' Selects Hospital Staff Complaint/Concerns for quarter three
    HospitalStaffComplaint_QTR3 = Range("BB3", "BB" & LastRow + 1).Value
    ' Selects Family Complaint/Concern/Grievance for quarter three
    FamilyComplaint_QTR3 = Range("BC3", "BC" & LastRow + 1).Value
    ' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter three
    MedicalStaffComplaint_QTR3 = Range("BD3", "BD" & LastRow + 1).Value
    ' Selects HCAHPS Physician Rate for quarter three
    HCAHPS_QTR3 = Range("BE3", "BE" & LastRow + 1).Value
    ' Selects Press Ganey Customer Satisfaction for quarter three
    PG_QTR3 = Range("BF3", "BF" & LastRow + 1).Value
    ' Selects the number of peer review cases for quarter four
    Peer_Review_Num_Cases_QTR4 = Range("BG3", "BG" & LastRow + 1).Value
    ' Selects the number of aspir. pneumonia for quarter four
    Aspir_Pneumonia_QTR4 = Range("BH3", "BH" & LastRow + 1).Value
    ' Selects CNS Complications for quarter four
    CNS_Complications_QTR4 = Range("BI3", "BI" & LastRow + 1).Value
    ' Selects Dental Trauma for quarter four
    Dental_Trauma_QTR4 = Range("BJ3", "BJ" & LastRow + 1).Value
    ' Selects MI within 48 hours for quarter four
    MI_48hrs_QTR4 = Range("BK3", "BK" & LastRow + 1).Value
    ' Selects Ocular Trauma for quarter four
    Ocular_Trauma_QTR4 = Range("BL3", "BL" & LastRow + 1).Value
    ' Selects Periph. Neuro Def. for quarter four
    Periph_Neuro_Def_QTR4 = Range("BM3", "BM" & LastRow + 1).Value
    ' Selects Post-LP Headache for quarter four
    Post_LP_Headache_QTR4 = Range("BN3", "BN" & LastRow + 1).Value
    ' Selects Respiratory Arrests for quarter four
    Respiratory_Arrests_QTR4 = Range("BO3", "BO" & LastRow + 1).Value
    ' Selects Unplanned ICU within 24 hours of anesthesia for quarter four
    Unplanned_ICU_QTR4 = Range("BP3", "BP" & LastRow + 1).Value
    ' Selects Other Complications for quarter four
    Other_Complications_QTR4 = Range("BQ3", "BQ" & LastRow + 1).Value
    ' Selects Number of Re-Intubations for quarter four
    Num_ReIntubations_QTR4 = Range("BR3", "BR" & LastRow + 1).Value
    ' Selects Number of Times Placed on Focused Review Due to Performance Issues for quarter four
    FocusedReview_PerformIssues_QTR4 = Range("BS3", "BS" & LastRow + 1).Value
    ' Selects Patient Complaint/Concern/Grievance for quarter four
    PatientComplaint_QTR4 = Range("BT3", "BT" & LastRow + 1).Value
    ' Selects Hospital Staff Complaint/Concerns for quarter four
    HospitalStaffComplaint_QTR4 = Range("BU3", "BU" & LastRow + 1).Value
    ' Selects Family Complaint/Concern/Grievance for quarter four
    FamilyComplaint_QTR4 = Range("BV3", "BV" & LastRow + 1).Value
    ' Selects Medical/AHP Staff Complaint/Concern/Grievance for quarter four
    MedicalStaffComplaint_QTR4 = Range("BW3", "BW" & LastRow + 1).Value
    ' Selects HCAHPS Physician Rate for quarter four
    HCAHPS_QTR4 = Range("BX3", "BX" & LastRow + 1).Value
    ' Selects Press Ganey Customer Satisfaction for quarter four
    PG_QTR4 = Range("BY3", "BY" & LastRow + 1).Value
    ' Imports SC's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\C,S.xls")
    awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("BZ1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects Number of Nosocomial Infection Issues for quarter one
    NosocomialInfections_QTR1 = Range("BZ3", "BZ" & LastRow + 1).Value
    ' Selects Number of Nosocomial Infection Issues for quarter two
    NosocomialInfections_QTR2 = Range("CA3", "CA" & LastRow + 1).Value
    ' Selects Number of Nosocomial Infection Issues for quarter three
    NosocomialInfections_QTR3 = Range("CB3", "CB" & LastRow + 1).Value
    ' Selects Number of Nosocomial Infection Issues for quarter four
    NosocomialInfections_QTR4 = Range("CC3", "CC" & LastRow + 1).Value
    ' Imports TC's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\C,T.xls")
    awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("CD1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects Number of Times Suspended for Delinquent Medical Records for quarter one
    HIM_Suspension_QTR1 = Range("CD3", "CD" & LastRow + 1).Value
    ' Selects Number of Times Suspended for Delinquent Medical Records for quarter two
    HIM_Suspension_QTR2 = Range("CE3", "CE" & LastRow + 1).Value
    ' Selects Number of Times Suspended for Delinquent Medical Records for quarter three
    HIM_Suspension_QTR3 = Range("CF3", "CF" & LastRow + 1).Value
    ' Selects Number of Times Suspended for Delinquent Medical Records for quarter four
    HIM_Suspension_QTR4 = Range("CG3", "CG" & LastRow + 1).Value
    ' Imports JH's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\H,J.xls")
    awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("CH1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects Meeting Attendance for quarter one
    Meeting_Attendance_QTR1 = Range("CH3", "CH" & LastRow + 1).Value
    ' Selects Meeting Attendance for quarter two
    Meeting_Attendance_QTR2 = Range("CI3", "CI" & LastRow + 1).Value
    ' Selects Meeting Attendance for quarter three
    Meeting_Attendance_QTR3 = Range("CJ3", "CJ" & LastRow + 1).Value
    ' Selects Meeting Attendance for quarter four
    Meeting_Attendance_QTR4 = Range("CK3", "CK" & LastRow + 1).Value
    ' Imports MJ's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\J,M.xls")
    awk.Sheets("Anesthesia").Range("C3", "R" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("CL1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects Drug Utilization Review for quarter one
    Drug_Utilization_QTR1 = Range("CL3", "CL" & LastRow + 1).Value
    ' Selects Illegible Handwriting for quarter one
    Illegible_Handwriting_QTR1 = Range("CM3", "CM" & LastRow + 1).Value
    ' Selects Unsafe Abbreviations for quarter one
    Unsafe_Abbreviations_QTR1 = Range("CN3", "CN" & LastRow + 1).Value
    ' Selects # of PRNs for quarter one
    PRNs_QTR1 = Range("CO3", "CO" & LastRow + 1).Value
    ' Selects Drug Utilization Review for quarter two
    Drug_Utilization_QTR2 = Range("CL3", "CL" & LastRow + 1).Value
    ' Selects Illegible Handwriting for quarter two
    Illegible_Handwriting_QTR2 = Range("CM3", "CM" & LastRow + 1).Value
    ' Selects Unsafe Abbreviations for quarter two
    Unsafe_Abbreviations_QTR2 = Range("CN3", "CN" & LastRow + 1).Value
    ' Selects # of PRNs for quarter two
    PRNs_QTR2 = Range("CO3", "CO" & LastRow + 1).Value
    ' Selects Drug Utilization Review for quarter three
    Drug_Utilization_QTR3 = Range("CL3", "CL" & LastRow + 1).Value
    ' Selects Illegible Handwriting for quarter three
    Illegible_Handwriting_QTR3 = Range("CM3", "CM" & LastRow + 1).Value
    ' Selects Unsafe Abbreviations for quarter three
    Unsafe_Abbreviations_QTR3 = Range("CN3", "CN" & LastRow + 1).Value
    ' Selects # of PRNs for quarter three
    PRNs_QTR3 = Range("CO3", "CO" & LastRow + 1).Value
    ' Selects Drug Utilization Review for quarter four
    Drug_Utilization_QTR4 = Range("CL3", "CL" & LastRow + 1).Value
    ' Selects Illegible Handwriting for quarter four
    Illegible_Handwriting_QTR4 = Range("CM3", "CM" & LastRow + 1).Value
    ' Selects Unsafe Abbreviations for quarter four
    Unsafe_Abbreviations_QTR4 = Range("CN3", "CN" & LastRow + 1).Value
    ' Selects # of PRNs for quarter four
    PRNs_QTR4 = Range("CO3", "CO" & LastRow + 1).Value
    ' Imports CL's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\L,C.xls")
    awk.Sheets("Anesthesia").Range("C3", "R" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("DB1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects NYPORTS for quarter one
    NYPORTS_QTR1 = Range("DB3", "DB" & LastRow + 1).Value
    ' Selects PRO Denials and Quality Issues for quarter one
    PRO_QTR1 = Range("DC3", "DC" & LastRow + 1).Value
    ' Selects DOH Reportable Incidents for quarter one
    DOH_QTR1 = Range("DD3", "DD" & LastRow + 1).Value
    ' Selects Blood Utilization Reivew for quarter one
    Blood_Utilization_QTR1 = Range("DE3", "DE" & LastRow + 1).Value
    ' Selects NYPORTS for quarter two
    NYPORTS_QTR2 = Range("DF3", "DF" & LastRow + 1).Value
    ' Selects PRO Denials and Quality Issues for quarter two
    PRO_QTR2 = Range("DG3", "DG" & LastRow + 1).Value
    ' Selects DOH Reportable Incidents for quarter two
    DOH_QTR2 = Range("DH3", "DH" & LastRow + 1).Value
    ' Selects Blood Utilization Reivew for quarter two
    Blood_Utilization_QTR2 = Range("DI3", "DI" & LastRow + 1).Value
    ' Selects NYPORTS for quarter three
    NYPORTS_QTR3 = Range("DJ3", "DJ" & LastRow + 1).Value
    ' Selects PRO Denials and Quality Issues for quarter three
    PRO_QTR3 = Range("DK3", "DK" & LastRow + 1).Value
    ' Selects DOH Reportable Incidents for quarter three
    DOH_QTR3 = Range("DL3", "DL" & LastRow + 1).Value
    ' Selects Blood Utilization Reivew for quarter three
    Blood_Utilization_QTR3 = Range("DM3", "DM" & LastRow + 1).Value
    ' Selects NYPORTS for quarter four
    NYPORTS_QTR4 = Range("DN3", "DN" & LastRow + 1).Value
    ' Selects PRO Denials and Quality Issues for quarter four
    PRO_QTR4 = Range("DO3", "DO" & LastRow + 1).Value
    ' Selects DOH Reportable Incidents for quarter four
    DOH_QTR4 = Range("DP3", "DP" & LastRow + 1).Value
    ' Selects Blood Utilization Reivew for quarter four
    Blood_Utilization_QTR4 = Range("DQ3", "DQ" & LastRow + 1).Value
    ' Imports PP's anesthesia data into the Individual Data spreadsheet
    Set awk = Workbooks.Open("E:\Practitioner Profiling\Practitioner Profiles\Reporting Individuals\P,P.xls")
    awk.Sheets("Anesthesia").Range("C3", "F" & LastRow + 3).Copy
    Individual_Data.Sheets("Anesthesia").Activate
    Range("DR1").Select
    ActiveSheet.Paste
    awk.Close SaveChanges:=False
    ' Selects Focus Peer Review for quarter one
    Focus_Peer_Review_QTR1 = Range("DR3", "DR" & LastRow + 1).Value
    ' Selects Focus Peer Review for quarter two
    Focus_Peer_Review_QTR2 = Range("DS3", "DS" & LastRow + 1).Value
    ' Selects Focus Peer Review for quarter three
    Focus_Peer_Review_QTR3 = Range("DT3", "DT" & LastRow + 1).Value
    ' Selects Focus Peer Review for quarter four
    Focus_Peer_Review_QTR4 = Range("DU3", "DU" & LastRow + 1).Value
    ' Turns on alerts
    Application.DisplayAlerts = True
    ' Activates CredData workbook and Anesthesia worksheet
    Set awk = Workbooks("CredData.xls")
    awk.Sheets("Anesthesia").Activate
    ' Selects active practitioner list with last name, first name, and title
    DocListName = Range("B2", "B" & LastRow).Value
    ' Counts the number of active practitioners
    num_DocListName = UBound(DocListName)
    ' Selects active practitioner list with first name, last name, and title
    DocFirstLast = Range("G2", "G" & LastRow).Value
    ' Selects status list
    StatusName = Range("H2", "H" & LastRow).Value
    ' Selects NYS License list
    NYSLic = Range("J2", "J" & LastRow).Value
    ' Selects boards list
    Boards = Range("K2", "K" & LastRow).Value
    ' Selects DEA list
    DEA = Range("L2", "L" & LastRow).Value
    ' Selects malpractice insurance list
    MalPrac = Range("N2", "N" & LastRow).Value
    ' Selects reappointment period list
    nxt_reappt_dt = Range("U2", "U" & LastRow).Value
    ' Asks user to input the year that the profiles will be for
    year = InputBox("Please enter the profile year:")
    If year = "" Then Exit Sub
    ' Creates new workbook for the department for the appropriate year
    Set wk = Workbooks.Add
    wk.SaveAs ("E:\Practitioner Profiling\TEST\Anesthesia " & year & ".xls")
    ' Creates sheets for each individual practitioner
    For i = 1 To UBound(DocListName)
    For Each objSheet In ActiveWorkbook.Sheets
    If objSheet.Name = DocListName(i, 1) Then Exit Sub
    Next objSheet
    Worksheets.Add after:=Sheets(ActiveWorkbook.Sheets.Count)
    ActiveSheet.Name = DocListName(i, 1)
    ActiveWindow.DisplayGridlines = False
    Next
    ' Deletes the worksheet's original blank sheet
    Application.DisplayAlerts = False
    Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    i = 1
    ' Opens profile template for anesthesia department and copies the template, then closes without saving changes
    Workbooks.Open ("E:\Practitioner Profiling\Modified Lakeside Templates\Anesthesiology Mock Up.xls")
    ActiveSheet.Range("A1:I94").Copy
    wk.Sheets(DocListName(i, 1)).Paste
    Application.DisplayAlerts = False
    ActiveWorkbook.Close SaveChanges:=False
    Application.DisplayAlerts = True
    ' Loop to paste the template into each practitioner's sheet, format the sheet, and add the practitioner's name and profile time period
    wk.Sheets(DocListName(1, 1)).Range("A1:I94").Copy
    For i = 1 To UBound(DocListName)
    For Each Sheet In wk.Sheets
    wk.Sheets(DocListName(1, 1)).Range("A1:I94").Copy
    wk.Sheets(DocListName(i, 1)).Paste
    wk.Sheets(DocListName(i, 1)).Activate
    ' Merges cells to keep profile formatting
    ActiveSheet.Range("A2:I2").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    ActiveSheet.Range("A4:I4").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    ActiveSheet.Range("A6:I6").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    ActiveSheet.Range("A30:I30").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge

    Range("B11:G11").Select
    With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = True
    End With
    Range("C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17").Select
    Range("C17").Activate
    Range("C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17,B33:H33,B53:H53,B59: H59" _
    ).Select
    Range("B59").Activate
    Range( _
    "C12:G12,C13:G13,C14:G14,C15:G15,C16:G16,C17:G17,B33:H33,B53:H53,B59:H59,B6 3:H63,B67:H67,B75:H75" _
    ).Select
    Range("B75").Activate
    With Selection
    .HorizontalAlignment = xlCenter
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
    End With
    Selection.Merge
    With Selection
    .HorizontalAlignment = xlLeft
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    End With


    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$94"
    ActiveSheet.Range("H9").Select
    ActiveCell.Value = year
    ActiveSheet.PageSetup.Zoom = False
    ActiveSheet.PageSetup.FitToPagesWide = 1
    ActiveSheet.PageSetup.FitToPagesTall = 1
    ActiveSheet.Range("C9").Select
    ActiveCell.Value = DocFirstLast(i, 1)
    ActiveSheet.PageSetup.CenterHorizontally = True
    ActiveSheet.PageSetup.CenterVertically = False
    ' Copy CredData
    ' Board Certification
    ActiveSheet.Range("C12").Select
    ActiveCell.Value = Boards(i, 1)
    ' Appointment Period
    ActiveSheet.Range("C13").Select
    ActiveCell.Value = nxt_reappt_dt(i, 1)
    ' Present Status
    ActiveSheet.Range("C14").Select
    ActiveCell.Value = StatusName(i, 1)
    ' NYS License Expiration
    ActiveSheet.Range("C15").Select
    ActiveCell.Value = NYSLic(i, 1)
    ' DEA Expiration
    ActiveSheet.Range("C16").Select
    ActiveCell.Value = DEA(i, 1)
    ' Insurance Expiration
    ActiveSheet.Range("C17").Select
    ActiveCell.Value = MalPrac(i, 1)
    ' Copy Individual Data
    ' Copy JBK's Data
    ' Peer Review: # Cases
    ActiveSheet.Range("C34").Select
    ActiveCell.Value = Peer_Review_Num_Cases_QTR1(i, 1)
    ActiveSheet.Range("D34").Select
    ActiveCell.Value = Peer_Review_Num_Cases_QTR2(i, 1)
    ActiveSheet.Range("E34").Select
    ActiveCell.Value = Peer_Review_Num_Cases_QTR3(i, 1)
    ActiveSheet.Range("F34").Select
    ActiveCell.Value = Peer_Review_Num_Cases_QTR4(i, 1)
    ' Aspir. Pneumonia
    ActiveSheet.Range("C41").Select
    ActiveCell.Value = Aspir_Pneumonia_QTR1(i, 1)
    ActiveSheet.Range("D41").Select
    ActiveCell.Value = Aspir_Pneumonia_QTR2(i, 1)
    ActiveSheet.Range("E41").Select
    ActiveCell.Value = Aspir_Pneumonia_QTR3(i, 1)
    ActiveSheet.Range("F41").Select
    ActiveCell.Value = Aspir_Pneumonia_QTR4(i, 1)
    ' CNS Complications
    ActiveSheet.Range("C42").Select
    ActiveCell.Value = CNS_Complications_QTR1(i, 1)
    ActiveSheet.Range("D42").Select
    ActiveCell.Value = CNS_Complications_QTR2(i, 1)
    ActiveSheet.Range("E42").Select
    ActiveCell.Value = CNS_Complications_QTR3(i, 1)
    ActiveSheet.Range("F42").Select
    ActiveCell.Value = CNS_Complications_QTR4(i, 1)
    ' Dental Trauma
    ActiveSheet.Range("C43").Select
    ActiveCell.Value = Dental_Trauma_QTR1(i, 1)
    ActiveSheet.Range("D43").Select
    ActiveCell.Value = Dental_Trauma_QTR2(i, 1)
    ActiveSheet.Range("E43").Select
    ActiveCell.Value = Dental_Trauma_QTR3(i, 1)
    ActiveSheet.Range("F43").Select
    ActiveCell.Value = Dental_Trauma_QTR4(i, 1)
    ' MI within 48 hours
    ActiveSheet.Range("C44").Select
    ActiveCell.Value = MI_48hrs_QTR1(i, 1)
    ActiveSheet.Range("D44").Select
    ActiveCell.Value = MI_48hrs_QTR2(i, 1)
    ActiveSheet.Range("E44").Select
    ActiveCell.Value = MI_48hrs_QTR3(i, 1)
    ActiveSheet.Range("F44").Select
    ActiveCell.Value = MI_48hrs_QTR4(i, 1)
    ' Ocular Trauma
    ActiveSheet.Range("C45").Select
    ActiveCell.Value = Ocular_Trauma_QTR1(i, 1)
    ActiveSheet.Range("D45").Select
    ActiveCell.Value = Ocular_Trauma_QTR2(i, 1)
    ActiveSheet.Range("E45").Select
    ActiveCell.Value = Ocular_Trauma_QTR3(i, 1)
    ActiveSheet.Range("F45").Select
    ActiveCell.Value = Ocular_Trauma_QTR4(i, 1)
    ' Periph. Neuro Def.
    ActiveSheet.Range("C46").Select
    ActiveCell.Value = Periph_Neuro_Def_QTR1(i, 1)
    ActiveSheet.Range("D46").Select
    ActiveCell.Value = Periph_Neuro_Def_QTR2(i, 1)
    ActiveSheet.Range("E46").Select
    ActiveCell.Value = Periph_Neuro_Def_QTR3(i, 1)
    ActiveSheet.Range("F46").Select
    ActiveCell.Value = Periph_Neuro_Def_QTR4(i, 1)
    ' Post-LP Headache
    ActiveSheet.Range("C47").Select
    ActiveCell.Value = Post_LP_Headache_QTR1(i, 1)
    ActiveSheet.Range("D47").Select
    ActiveCell.Value = Post_LP_Headache_QTR2(i, 1)
    ActiveSheet.Range("E47").Select
    ActiveCell.Value = Post_LP_Headache_QTR3(i, 1)
    ActiveSheet.Range("F47").Select
    ActiveCell.Value = Post_LP_Headache_QTR4(i, 1)
    ' Respiratory Arrests
    ActiveSheet.Range("C48").Select
    ActiveCell.Value = Respiratory_Arrests_QTR1(i, 1)
    ActiveSheet.Range("D48").Select
    ActiveCell.Value = Respiratory_Arrests_QTR2(i, 1)
    ActiveSheet.Range("E48").Select
    ActiveCell.Value = Respiratory_Arrests_QTR3(i, 1)
    ActiveSheet.Range("F48").Select
    ActiveCell.Value = Respiratory_Arrests_QTR4(i, 1)
    ' Unplanned ICU visit within 24 hours of anesthesia
    ActiveSheet.Range("C49").Select
    ActiveCell.Value = Unplanned_ICU_QTR1(i, 1)
    ActiveSheet.Range("D49").Select
    ActiveCell.Value = Unplanned_ICU_QTR2(i, 1)
    ActiveSheet.Range("E49").Select
    ActiveCell.Value = Unplanned_ICU_QTR3(i, 1)
    ActiveSheet.Range("F49").Select
    ActiveCell.Value = Unplanned_ICU_QTR4(i, 1)
    ' Other Complications
    ActiveSheet.Range("C50").Select
    ActiveCell.Value = Other_Complications_QTR1(i, 1)
    ActiveSheet.Range("D50").Select
    ActiveCell.Value = Other_Complications_QTR2(i, 1)
    ActiveSheet.Range("E50").Select
    ActiveCell.Value = Other_Complications_QTR3(i, 1)
    ActiveSheet.Range("F50").Select
    ActiveCell.Value = Other_Complications_QTR4(i, 1)
    ' Number of Reintubations
    ActiveSheet.Range("C65").Select
    ActiveCell.Value = Num_ReIntubations_QTR1(i, 1)
    ActiveSheet.Range("D65").Select
    ActiveCell.Value = Num_ReIntubations_QTR2(i, 1)
    ActiveSheet.Range("E65").Select
    ActiveCell.Value = Num_ReIntubations_QTR3(i, 1)
    ActiveSheet.Range("F65").Select
    ActiveCell.Value = Num_ReIntubations_QTR4(i, 1)
    ' Number of Times Placed on Focused Review Due to Performance Issues
    ActiveSheet.Range("C62").Select
    ActiveCell.Value = FocusedReview_PerformIssues_QTR1(i, 1)
    ActiveSheet.Range("D62").Select
    ActiveCell.Value = FocusedReview_PerformIssues_QTR2(i, 1)
    ActiveSheet.Range("E62").Select
    ActiveCell.Value = FocusedReview_PerformIssues_QTR3(i, 1)
    ActiveSheet.Range("F62").Select
    ActiveCell.Value = FocusedReview_PerformIssues_QTR4(i, 1)
    ' Patient Complaint/Concern/Grievance
    ActiveSheet.Range("C68").Select
    ActiveCell.Value = PatientComplaint_QTR1(i, 1)
    ActiveSheet.Range("D68").Select
    ActiveCell.Value = PatientComplaint_QTR2(i, 1)
    ActiveSheet.Range("E68").Select
    ActiveCell.Value = PatientComplaint_QTR3(i, 1)
    ActiveSheet.Range("F68").Select
    ActiveCell.Value = PatientComplaint_QTR4(i, 1)
    ' Hospital Staff Complaint/Concerns
    ActiveSheet.Range("C69").Select
    ActiveCell.Value = HospitalStaffComplaint_QTR1(i, 1)
    ActiveSheet.Range("D69").Select
    ActiveCell.Value = HospitalStaffComplaint_QTR2(i, 1)
    ActiveSheet.Range("E69").Select
    ActiveCell.Value = HospitalStaffComplaint_QTR3(i, 1)
    ActiveSheet.Range("F69").Select
    ActiveCell.Value = HospitalStaffComplaint_QTR4(i, 1)
    ' Family Complaint/Concern/Grievance
    ActiveSheet.Range("C70").Select
    ActiveCell.Value = FamilyComplaint_QTR1(i, 1)
    ActiveSheet.Range("D70").Select
    ActiveCell.Value = FamilyComplaint_QTR2(i, 1)
    ActiveSheet.Range("E70").Select
    ActiveCell.Value = FamilyComplaint_QTR3(i, 1)
    ActiveSheet.Range("F70").Select
    ActiveCell.Value = FamilyComplaint_QTR4(i, 1)
    ' Medical/AHP Staff Complaint/Concern
    ActiveSheet.Range("C71").Select
    ActiveCell.Value = MedicalStaffComplaint_QTR1(i, 1)
    ActiveSheet.Range("D71").Select
    ActiveCell.Value = MedicalStaffComplaint_QTR2(i, 1)
    ActiveSheet.Range("E71").Select
    ActiveCell.Value = MedicalStaffComplaint_QTR3(i, 1)
    ActiveSheet.Range("F71").Select
    ActiveCell.Value = MedicalStaffComplaint_QTR4(i, 1)
    ' HCAHPS Physician Rate
    ActiveSheet.Range("C72").Select
    ActiveCell.Value = HCAHPS_QTR1(i, 1)
    ActiveSheet.Range("D72").Select
    ActiveCell.Value = HCAHPS_QTR2(i, 1)
    ActiveSheet.Range("E72").Select
    ActiveCell.Value = HCAHPS_QTR3(i, 1)
    ActiveSheet.Range("F72").Select
    ActiveCell.Value = HCAHPS_QTR4(i, 1)
    ' Press Ganey Customer Satisfaction
    ActiveSheet.Range("C73").Select
    ActiveCell.Value = PG_QTR1(i, 1)
    ActiveSheet.Range("D73").Select
    ActiveCell.Value = PG_QTR2(i, 1)
    ActiveSheet.Range("E73").Select
    ActiveCell.Value = PG_QTR3(i, 1)
    ActiveSheet.Range("F73").Select
    ActiveCell.Value = PG_QTR4(i, 1)
    ' Copy SC's Data
    ' Number of Nosocomial Infection Issues
    ActiveSheet.Range("C54").Select
    ActiveCell.Value = NosocomialInfections_QTR1(i, 1)
    ActiveSheet.Range("D54").Select
    ActiveCell.Value = NosocomialInfections_QTR2(i, 1)
    ActiveSheet.Range("E54").Select
    ActiveCell.Value = NosocomialInfections_QTR3(i, 1)
    ActiveSheet.Range("F54").Select
    ActiveCell.Value = NosocomialInfections_QTR4(i, 1)
    ' Copy TC's Data
    ' Number of Times Suspended for Delinquent Medical Records
    ActiveSheet.Range("C79").Select
    ActiveCell.Value = HIM_Suspension_QTR1(i, 1)
    ActiveSheet.Range("D79").Select
    ActiveCell.Value = HIM_Suspension_QTR2(i, 1)
    ActiveSheet.Range("E79").Select
    ActiveCell.Value = HIM_Suspension_QTR3(i, 1)
    ActiveSheet.Range("F79").Select
    ActiveCell.Value = HIM_Suspension_QTR4(i, 1)
    ' Copy JH's Data
    ' Meeting Attendance
    ActiveSheet.Range("C61").Select
    ActiveCell.Value = Meeting_Attendance_QTR1(i, 1)
    ActiveSheet.Range("D61").Select
    ActiveCell.Value = Meeting_Attendance_QTR2(i, 1)
    ActiveSheet.Range("E61").Select
    ActiveCell.Value = Meeting_Attendance_QTR3(i, 1)
    ActiveSheet.Range("F61").Select
    ActiveCell.Value = Meeting_Attendance_QTR4(i, 1)
    ' Copy MJ's Data
    ' Drug Utilization Review
    ActiveSheet.Range("C51").Select
    ActiveCell.Value = Drug_Utilization_QTR1(i, 1)
    ActiveSheet.Range("D51").Select
    ActiveCell.Value = Drug_Utilization_QTR2(i, 1)
    ActiveSheet.Range("E51").Select
    ActiveCell.Value = Drug_Utilization_QTR3(i, 1)
    ActiveSheet.Range("F51").Select
    ActiveCell.Value = Drug_Utilization_QTR4(i, 1)
    ' Illegible Handwriting
    ActiveSheet.Range("C77").Select
    ActiveCell.Value = Illegible_Handwriting_QTR1(i, 1)
    ActiveSheet.Range("D77").Select
    ActiveCell.Value = Illegible_Handwriting_QTR2(i, 1)
    ActiveSheet.Range("E77").Select
    ActiveCell.Value = Illegible_Handwriting_QTR3(i, 1)
    ActiveSheet.Range("F77").Select
    ActiveCell.Value = Illegible_Handwriting_QTR4(i, 1)
    ' Unsafe Abbreviations
    ActiveSheet.Range("C76").Select
    ActiveCell.Value = Unsafe_Abbreviations_QTR1(i, 1)
    ActiveSheet.Range("D76").Select
    ActiveCell.Value = Unsafe_Abbreviations_QTR2(i, 1)
    ActiveSheet.Range("E76").Select
    ActiveCell.Value = Unsafe_Abbreviations_QTR3(i, 1)
    ActiveSheet.Range("F76").Select
    ActiveCell.Value = Unsafe_Abbreviations_QTR4(i, 1)
    ' Number of PRNs
    ActiveSheet.Range("C80").Select
    ActiveCell.Value = PRNs_QTR1(i, 1)
    ActiveSheet.Range("D80").Select
    ActiveCell.Value = PRNs_QTR2(i, 1)
    ActiveSheet.Range("E80").Select
    ActiveCell.Value = PRNs_QTR3(i, 1)
    ActiveSheet.Range("F80").Select
    ActiveCell.Value = PRNs_QTR4(i, 1)
    ' Copy CL's Data
    ' NYPORTS
    ActiveSheet.Range("C52").Select
    ActiveCell.Value = NYPORTS_QTR1(i, 1)
    ActiveSheet.Range("D52").Select
    ActiveCell.Value = NYPORTS_QTR2(i, 1)
    ActiveSheet.Range("E52").Select
    ActiveCell.Value = NYPORTS_QTR3(i, 1)
    ActiveSheet.Range("F52").Select
    ActiveCell.Value = NYPORTS_QTR4(i, 1)
    ' PRO Denials and Quality Issues
    ActiveSheet.Range("C56").Select
    ActiveCell.Value = PRO_QTR1(i, 1)
    ActiveSheet.Range("D56").Select
    ActiveCell.Value = PRO_QTR2(i, 1)
    ActiveSheet.Range("E56").Select
    ActiveCell.Value = PRO_QTR3(i, 1)
    ActiveSheet.Range("F56").Select
    ActiveCell.Value = PRO_QTR4(i, 1)
    ' DOH Reportable Incidents
    ActiveSheet.Range("C55").Select
    ActiveCell.Value = DOH_QTR1(i, 1)
    ActiveSheet.Range("D55").Select
    ActiveCell.Value = DOH_QTR2(i, 1)
    ActiveSheet.Range("E55").Select
    ActiveCell.Value = DOH_QTR3(i, 1)
    ActiveSheet.Range("F55").Select
    ActiveCell.Value = DOH_QTR4(i, 1)
    ' Blood Utilization Review
    ActiveSheet.Range("C57").Select
    ActiveCell.Value = Blood_Utilization_QTR1(i, 1)
    ActiveSheet.Range("D57").Select
    ActiveCell.Value = Blood_Utilization_QTR2(i, 1)
    ActiveSheet.Range("E57").Select
    ActiveCell.Value = Blood_Utilization_QTR3(i, 1)
    ActiveSheet.Range("F57").Select
    ActiveCell.Value = Blood_Utilization_QTR4(i, 1)
    ' Copy PP's Data
    ' Focus Peer Review
    ActiveSheet.Range("C64").Select
    ActiveCell.Value = Focus_Peer_Review_QTR1(i, 1)
    ActiveSheet.Range("D64").Select
    ActiveCell.Value = Focus_Peer_Review_QTR2(i, 1)
    ActiveSheet.Range("E64").Select
    ActiveCell.Value = Focus_Peer_Review_QTR3(i, 1)
    ActiveSheet.Range("F64").Select
    ActiveCell.Value = Focus_Peer_Review_QTR4(i, 1)

    ActiveSheet.Columns("A:I").Select
    ActiveSheet.Columns("A:I").EntireColumn.AutoFit
    ActiveSheet.Rows("1:94").Select
    ActiveSheet.Rows("1:94").EntireRow.AutoFit
    Rows("18:19").Select
    Selection.EntireRow.Hidden = True
    Rows("60").Select
    Selection.EntireRow.Hidden = True
    Rows("66").Select
    Selection.EntireRow.Hidden = True
    Rows("72").Select
    Selection.EntireRow.Hidden = True
    Rows("78").Select
    Selection.EntireRow.Hidden = True
    i = i + 1
    Next
    Next
    Workbooks("Individual Data.xls").Close SaveChanges:=True
    Workbooks("Anesthesia " & year & ".xls").Save
    Workbooks("CredData.xls").Close SaveChanges:=True

    End Sub
    [/vba]

    Thanks so much!

    Giraffe3289

  2. #2
    VBAX Expert
    Joined
    Aug 2007
    Location
    Windermere, FL, a 'burb in the greater Orlando metro area.
    Posts
    567
    Location
    Giraffe3289,

    Your organization has a systemic problem in the Access database's tables.

    The master record(s) for the doctors in the files and database tables must have begin date and termination date fields for each doctor. And the tables should enforce the rule that no record(s) can be purged from a file or table during the period of time that your reports need to cover. So, at the very least, no purges in the current year for any doctor active during any part of the year.

    These doctors (and their data needed for reports) need to stay in the files, tables and subsidiary records until they age out. Thus, if you need to prepare year-to-year comparisons of summarized data for the current and last 5 years (as a for instance), a doctor's records remain in the file until the end (termination) date is older than the oldest begin date of any period being reported on.

    These are quick, random reactions to your query.

    HTH,
    Ron
    Windermere, FL

  3. #3
    The data is imported through a database query, so I'm sure I can talk to some people and get the query changed.

    Any input on the linking situation or do you think that I'm pretty much stuck with it?

    Thanks,

    Giraffe3289

  4. #4
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,059
    Location
    One quick thing that came to mind is the non use of Option Explicit. Is it there in the real version of the code?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •