How do I increase efficiency or stop the lag?

A

Aphten

New Member
Joined
Jul 24, 2024
Messages
15
Office Version
  1. 2021
Platform
  1. Windows
I have a work sheet that utilizes worksheet_change with the code that I have included below. Don't mind all the notes. I am new to VBA. It is a lot, but I am hoping that including all of it will show the entire picture. There is no conditional formatting but I do have some macros assigned to a couple buttons for this sheet.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Changed As Range, c As Range
    Set Changed = Intersect(Target, Union(Range("AI13:AI14,H17,P17:P19,R16,T16:T19,AA17:AA18,AI16,G21,G24,S20:S22,AA20:AA22,AH21:AH25" _
    ), Range( _
    "AP21:AP24,AK28:AL28,AK30:AL30,AK32:AL32,AP28:AP31,AX32,AY44,AY48,AP45:AP47,AY48,AP49:AP54,AP56:AP60,AY64,AP65,AU65,W66,C38:C65" _
    ), Range( _
    "V38:V65,W66,C67:C70,AJ67:AJ68,AV69,Y71:AW74,C72:C79,L80,R80,C81:C82,C86:C94,K86:K94,AD77,AC77:AD80,AK77:AL80,AS77:AT80" _
    ), Range( _
    "Y82:Y84,AG81,AG83,G96,G98,Y86,AG88,AG90:AG92,AG95,AG97:AG98,AO87:AU99" _
    )))
    If Not Changed Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            For Each c In Changed
              c.Value = UCase(c.Value)
            Next c
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If

    Set Changed = Intersect(Target, Range("J13,H37"))
    If Not Changed Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            For Each c In Changed
              c.Value = StrConv(c.Value, vbProperCase)
            Next c
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If

    Set Changed = Intersect(Target, Range("S20:S22,AA20:AA22,AH21:AH25,C38:C65,V38:V65,AY44,AY48,W66,AD77,AC78:AC80,AK77:AK80,AS77:AS80,Y86,C86,K86,C72"))
    If Not Changed Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            For Each c In Changed
              If c.Value <> "" Then
              c.Value = "P"
            End If
            Next c
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
'
'
'
'A: MCD [1 of 3]--> If the resident does not have MCD [AI14=NO], then the cell is highlighted.
'
    Select Case Range("AI14").Value
    Case "NO"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            Range("AI14").Interior.Color = RGB(255, 255, 0) 'yellow
            Range("AI14").Font.Color = RGB(255, 0, 0)       'red
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Select
'
'A: MCD [2 of 3]--> If the MCD # cell [AI14] is blank, then the cell fill matches and font is normal.
'
    Select Case Range("AI14").Value
    Case ""
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            Range("AI14").Interior.Color = RGB(226, 239, 218) 'light green
            Range("AI14").Font.Color = RGB(0, 112, 192)       'navy blue
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Select
'
'A: MCD [3 of 3]--> If the MCD # cell [AI14] has a MCD number, then the cell fill matches and font is normal.
'
    Select Case Range("AI14").Value
    Case Is <> "NO"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
            Range("AI14").Interior.Color = RGB(226, 239, 218) 'light green
            Range("AI14").Font.Color = RGB(0, 112, 192)       'navy blue
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End Select
'
'A: LANGUAGE [1 of 2]--> If language is English [I17=English] then resident does not need an interpreter [H17=N].
'
Select Case Range("I17").Value
Case "English"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("H17").Value = "N"
        Range("H17").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'A: Language [2 of 2]---> If language cell [I17] is blank, then interpreter cell [H17] is blank.
'
Select Case Range("I17").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("H17").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'A: PASRR [1 of 4]--> If resident does not have a PASRR Level II [R16=N] or the cell is blank, then SMI, ID,
'and other [Q17:Q19] are hidden.
'
Select Case Range("R16").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Q17:Q19").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'A: PASRR [2 of 4]--> If resident has a Level II PASRR [R16=Y], then SMI, ID, and other [Q17:Q19] are visible.
'
Select Case Range("R16").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Q17:Q19").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'A: PASRR [3 of 4]--> If resident does not have an ID or an IDD with organic condition [T16=N], then Down Syndrome, Epilepsy,
'Autism, and other [U17:U18 + AB17:AB18] are hidden.
'
Select Case Range("T16").Value
Case "N"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("U17:U18").NumberFormat = ";;;"
        Range("AB17:AB18").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'A: PASRR [4 of 4]--> If resident has an ID or an IDD with organic condition [T16=Y] or the subsequent cell is blank, then
'Down Syndrome, Epilepsy, Autism, and other [U17:U18 + AB17:AB18] are visible.
'
Select Case Range("T16").Value
Case "Y", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("U17:U18").NumberFormat = "text"
        Range("AB17:AB18").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'E: BEHAVIORS [1 of 2] 'If resident had behaviors [G24=Y], then days [C25] is visible.
'
Select Case Range("G24").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C25").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'E: BEHAVIORS [2 of 2]'  If the resident did not have behaviors [G24=N] or the cell is blank, then days [C25] is hidden.
'
Select Case Range("G24").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C25").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'GG [1 of 17]: UDA --> If there is no IDT UDA or note [Q20=N], then the cell is highlighted and font is red.
'
Select Case Range("Q20").Value
Case "NO"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Q20").Interior.Color = RGB(255, 255, 0)
        Range("Q20").Font.Color = RGB(255, 0, 0)
        Range("Q20").Font.Bold = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [2 of 17]: UDA--> If there is an IDT UDA or note [Q20=UDA or note] or the cell is blank, then fill matches section GG and text. is normal.
'
Select Case Range("Q20").Value
Case "UDA", "note", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Q20").Interior.Color = RGB(237, 237, 237)
        Range("Q20").Font.Color = RGB(0, 112, 192)
        Range("Q20").Font.Bold = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [3 of 17]: PRIOR DEVICES--> If resident did not use any devices prior to most recent illness [S20=P], then options
'[T21:T22 + AB20:AB22] are hidden.
'
Select Case Range("S20").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("T21:T22").NumberFormat = ";;;"
        Range("AB20:AB22").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [4 of 17]: PRIOR DEVICES--> If resident used any device prior to the most recent illness [S20=P] or the cell is blank, then
'options are [T21:T22 + AB20:AB22] visible.
'
Select Case Range("S20").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("T21:T22 ").NumberFormat = "text"
        Range("AB20:AB22").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [5 of 17]: CURRENT DEVICES--> If resident did not use any devices during the lookback [AH21=P], then options [AI21:AI25] are
'hidden.
'
Select Case Range("AH21").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AI22:AI25").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [6 of 17]: CURRENT DEVICES--> If resident used any device during the lookback period [AH21=blank], then options are visible.
'
Select Case Range("AH21").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AI21:AI25").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [7 of 17]: ADLs--> If walk 10ft's (column 1) score is 7, 9, 10, or 88 [BE13 = True] then all walk scores [AD29:AD31] match.
'BE13 = AE28 > 6.
'
Select Case Range("BE13").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AD29:AD31").Value = Range("AD28").Value
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [8 of 17]: ADLs--> If walk 10ft's score (column 2) is 7,9,10, or 88, [BE14=True] then all walk scores [AE29:AE31] match.
'BE14 = AD28 >6.
'
Select Case Range("BE14").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE29:AE31").Value = Range("AE28").Value
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [9 of 17]: ADLs--> If walk 10ft's score (column 1) [AD28] is blank, then all walk scores [AD29:AD31] are blank.
'
Select Case Range("AD28").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AD29:AD31").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [10 of 17]: ADLs--> If walk 10ft's score (column 2) [AE28] is blank, then all walk scores [AE29:AE31] are blank.
'
Select Case Range("AE28").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE29:AE31").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [11 of 17]: ADLs--> If 1 step's score (column 1) is 7, 9, 10, or 88 [BE15=True], then all step scores [AD33:AD34] match.
'BE15 = AD31 >6.
'
Select Case Range("BE15").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AD33:AD34").Value = Range("AD32").Value
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [12 of 17]: ADLs--> If 1 step's score (column 2) is 7, 9, 10, or 88 [BE16=True], then all step scores [AE33:AE34] match.
'BE16 = AE31 >6.
'
Select Case Range("BE16").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE33:AE34").Value = Range("AE32").Value
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [13 of 17]: ADLs--> If 1 step's score (column 1) [AD32] is blank, then all step scores [AD33:AD34] are blank.
'
Select Case Range("AD32").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AD33:AD34").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [14 of 17]: ADLs--> If 1 step's score (column 2) [AE32] is blank, then all step scores [AE33:AE34] are blank.
'
Select Case Range("AE32").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE33:AE34").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [15 of 17]: ADLs--> If resident did not use a wheelchair [BE19=True], then 50ft/TYPE and 150ft/TYPE [AM29:AM32] are hidden.
'BE19 = N in either column [AK28 or AL28 ] + no Y in either column [AK28 or AL28].
'
Select Case Range("BE19").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AM29:AM32").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [16 of 17]: ADLs--> If resident wheelchair use cells are blank [BE20=True], then 50ft/TYPE and 150ft/TYPE [AM29:AM32] are
'hidden.
'BE20 = blank in both columns [AK28 and AL28]
'
Select Case Range("BE20").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AM29:AM32").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'GG [17 of 17]: ADLs--> If resident used a wheelchair [BE21=True], then 50ft/TYPE and 150ft/TYPE [AM29:AM32] are visible.
'BE21 = Y in either column [AK28 or AL28]
'
Select Case Range("BE21").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AM29:AM32").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'H [1 of 2]: CATHETER--> If resident has an indwelling catheter [AP21 = Y], then diagnosis [AV21] is visible.
'
Select Case Range("AP21").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AV21").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'H [2 of 2]: CATHETER--> If they do not have an indwelling catheter [AP21 = N] or the cell is blank, then diagnosis [AV21] is
'hidden.
'
Select Case Range("AP21").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AV21").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'J [1 of 15]: PAIN--> If resident is interviewable [AP28 = Y], then resident pain interview [AP32:AW32] is visible and staff
'interview [AP39:AP43] are hidden.
'
Select Case Range("AP28").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP32:AW32").Font.Color = RGB(0, 0, 0)
        Range("AP39:AP43").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [2 of 15]: PAIN--> If resident reports pain [AX32 = Y], then rest of the pain interview [AP33:AP37] is visible.
'
Select Case Range("AX32").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP33:AP37").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [3 of 15]: PAIN--> If resident denies pain [AX32 = N] or the cell is blank, then rest of the pain interview [AP33:AP37] is
'hidden.
'
Select Case Range("AX32").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP33:AP37").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [4 of 15]: PAIN--> If resident is not interviewable [AP28 = N], then staff interview [AP38:AP43] is visible and resident
'interview [AP32:AW32] is hidden.
'
Select Case Range("AP28").Value
Case "N"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP38:AP43").Font.Color = RGB(0, 0, 0)
        Range("AP32:AW32").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [5 of 15]: PAIN--> If interviewable cell [AP28] is blank, then neither resident interview [AP32:AW32] or staff interview
'[AP38:AP43] are visible.
'
Select Case Range("AP28").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP32:AW32").NumberFormat = "text"
        Range("AP38:AP43").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [6 of 15]: SOB--> If the resident denies all SOB [AY44 = checked] or the cell is blank, then WITH EXERTION, SITTING AT REST, and LYING
'FLAT [AQ45:AQ47] are hidden.
'
Select Case Range("AY44").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AQ45:AQ47").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [7 of 15]: SOB--> If the none option for SOB [AY44] is blank, then WITH EXERTION, SITTING AT REST, and LYING FLAT [AQ45:AQ47]
'are visible.
'
Select Case Range("AY44").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AQ45:AQ47").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [8 of 15]: OTHER CONDITIONS--> If the resident did not have any other conditions [AY48 = checked], then all options [AQ49:AQ54] are
'hidden.
'
Select Case Range("AY48").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AQ49:AQ54").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [9 of 15]: OTHER CONDITIONS--> If the none option for other conditions [AY48] is blank then all of the options are visible.
'
Select Case Range("AY48").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AQ49:AQ54").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [10 of 15]: FALLS PRIOR TO ADMISSION--> If the resident had falls prior admission [AP56 = Y], then in the last 30 days, in the
'last 2-6 months, and fractures related to falls [AR57:AR59] are visible.
'
Select Case Range("AP56").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AR57:AR59").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [11 of 15]: FALLS PRIOR TO ADMISSION--> If the resident had no falls prior admission [AP56 = N] or the subsequent cell is blank,
'then in the last 30 days, in the last 2-6 months, and fractures related to falls [AR57:AR59] are hidden.
'
Select Case Range("AP56").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AR57:AR59").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [12 of 15]: FALLS AFTER ADMISSION--> If the resident had falls after admission [AP60 = Y], then no injury, minor injury, and
'major injury [AR61:AR63] are visible.
'
Select Case Range("AP60").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AR61:AR63").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [13 of 15]: FALLS AFTER ADMISSION--> If resident did not have any falls after admission [AP60 = N] or the cell is blank, then
'no injury, minor injury, and major injury [AR61:AR63] are hidden.
'
Select Case Range("AP60").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AR61:AR63").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [14 of 15]: SURGERY--> If the resident had surgery in the last 100 days prior to admission or during their previous stay
'immediately preceding admission that required a SNF stay [AY64 = Y], then last 100 days [AQ65] and requiring SNF [AV65] are
'visible.
'
Select Case Range("AY64").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AQ65").NumberFormat = "text"
        Range("AV65").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'J [15 of 15]: SURGERY--> If the resident did not have surgery in the last 100 days prior to admission or during their previous
'stay immediately preceding admission that required a SNF stay [AY64 = N], or the subsequent cell is blank, then
'last 100 days [AQ65] and requiring SNF [AV65] are hidden.
'
Select Case Range("AY64").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
       Range("AQ65").NumberFormat = ";;;"
        Range("AV65").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'K [1 of 19]:--> SWALLOW--> If the none option for swallowing issues, concern, or complaints [W66] is blank, then all
'options [D67:D70] are visible.
'
Select Case Range("W66").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D67:D70").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [2 of 19]:--> SWALLOW--> If resident did not have any swallowing issues, concern, or complaints [W66 = checked], then all
'options [D67:D70] are hidden.
'
Select Case Range("W66").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D67:D70").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [3 of 19]: WEIGHT--> If height or weight is missing [BE24 = True], then
'BMI cell [Y69] is highlighted and font is bold red,
'BMI result cell [AC69] is highlighted and font is regular,
' and the next cell to the right [AE69] is highlighted, the text is red, and it is aligned to the left, and it reads '<---???'.
'
'BE24 = [BE22 = True] or [BE23 = True]
'BE22 = weight [AC68] but not height [AC67]
'BE23 = height [AC67] but not weight [AC68].
'
Select Case Range("BE24").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y69").Interior.Color = RGB(255, 255, 0)
        Range("Y69").Font.Bold = True
        Range("Y69").Font.Color = RGB(255, 0, 0)
        Range("AC69").Interior.Color = RGB(255, 255, 0)
        Range("AC69").Font.Color = RGB(0, 112, 192)
        Range("AE69").Interior.Color = RGB(255, 255, 0)
        Range("AE69").Font.Color = RGB(255, 0, 0)
        Range("AE69").HorizontalAlignment = xlLeft
        Range("AE69").Value = "  <--- ???"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [4 of 19]:--> WEIGHT--> If there is a height, a weight, and BMI is <35 [BE25 = True], then
'BMI cell [Y69] is not highlighted, text is not bold and text color is black,
'BMI result cell [AC69] is not highlighted and text is normal color,
'the next cell to the right [AE69] is not highlighted, font color is normal, horizontal allignment is centered, and it is blank
'BE25 = height [AC67] is not blank, weight [AC68] is not blank, and BMI [AC69] is under 35.
'
Select Case Range("BE25").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y69").Interior.Color = RGB(255, 201, 255)
        Range("Y69").Font.Bold = False
        Range("Y69").Font.Color = RGB(0, 0, 0)
        Range("AC69").Interior.Color = RGB(255, 201, 255)
        Range("AC69").Font.Color = RGB(0, 112, 192)
        Range("AE69").Interior.Color = RGB(255, 201, 255)
        Range("AE69").Font.Color = RGB(0, 112, 192)
        Range("AE69").HorizontalAlignment = xlCenter
        Range("AE69").Value = ""
   Application.ScreenUpdating = True
   Application.EnableEvents = True
End Select
'
'K [5 of 19]:--> WEIGHT--> If there is a height, a weight, and BMI 35 or higher [BE26 = True], then
'the BMI cell [Y69] is highlighted and the text is green,
'BMI result cell [AC69] is highlighted and text is green,
'the next cell to the right [AE69] is highlighted, text is green and centered, and it reads Morbid Obesity???
'BE26 = height [AC67] is not blank, weight [AC68] is not blank, and BMI [AC69] is 35 or higher [BE33 = True].
'
Select Case Range("BE26").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y69").Interior.Color = RGB(255, 255, 0)
        Range("Y69").Font.Bold = True
        Range("Y69").Font.Color = RGB(0, 180, 0)
        Range("AC69").Interior.Color = RGB(255, 255, 0)
        Range("AC69").Font.Color = RGB(0, 180, 0)
        Range("AE69").Interior.Color = RGB(255, 255, 0)
        Range("AE69").Font.Color = RGB(0, 180, 0)
        Range("AE69").HorizontalAlignment = xlCenter
        Range("AE69").Value = "<--- Morbid Obesity???"
   Application.ScreenUpdating = True
   Application.EnableEvents = True
End Select
'
'K [6 of 19]:--> WEIGHT--> If height [AC67] and weight [AC68] are both blank [BE28=True], then
'the BMI cell [Y69] is not highlighted and the text is black,
'BMI result cell [AC69] is not highlighted and text is normal,
'the next cell to the right [AE69] is not highlighted, text is blue and centered, and it is blank
'BE28 = height [AC67] is  blank and weight [AC68] is  blank.
'
Select Case Range("BE28").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y69").Interior.Color = RGB(255, 201, 255)
        Range("Y69").Font.Bold = False
        Range("Y69").Font.Color = RGB(0, 0, 0)
        Range("AC69").Interior.Color = RGB(255, 201, 255)
        Range("AC69").Font.Color = RGB(0, 112, 192)
        Range("AE69").Interior.Color = RGB(255, 201, 255)
        Range("AE69").Font.Color = RGB(0, 180, 0)
        Range("AE69").HorizontalAlignment = xlCenter
        Range("AE69").Value = ""
   Application.ScreenUpdating = True
   Application.EnableEvents = True
End Select
'
'K [7 of 19]: WEIGHT--> If 30 day weight [AV67] is blank, then LAST 30 DAYS [AP67] is visible and
'the 30 day weight result cell has normal font.
'
Select Case Range("AV67").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP67").NumberFormat = "text"
        Range("AV67").Font.Color = RGB(0, 112, 192)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [8 of 19]: WEIGHT--> If 6 month weight [AV68] is blank, then last 6 months [AP68] is visible and
'the 6 month weight result cell has normal font.
'
Select Case Range("AV68").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP68").NumberFormat = "text"
        Range("AV68").Font.Color = RGB(0, 112, 192)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [9 of 19]: WEIGHT--> If a 30 day weight is not available [AV67 = N/A] then last 30 days [AP67] and the cell to the right [AV67]
'is hidden.
'
Select Case Range("AV67").Value
Case "N/A"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP67").NumberFormat = ";;;"
        Range("AV67").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [10 of 19]: WEIGHT--> If a 6 month weight is not available [AV68 = N/A] then last 6 months [AP68] and the cell to the right
'[AV68] is hidden.
'
Select Case Range("AV68").Value
Case "N/A"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP68").NumberFormat = ";;;"
        Range("AV68").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [11 of 19]: WEIGHT--> If resident has a 30 day weight gain or loss of more than 5% [BE29 = True], then text is red.
'BE29 = 30 day weight gain [AY67] is 5% or higher or 30 day weight loss [AY67] is 5% or higher
'
Select Case Range("BE29").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AY67").Font.Color = RGB(255, 0, 0)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [12 of 19]: WEIGHT--> If resident does not have a 30 day weight gain or loss of more than 5% [BE29 = False], then text is
'normal.
'BE29 = 30 day weight gain [AY67] is 5% or higher or 30 day weight loss [AY67] is 5% or higher.
'
Select Case Range("BE29").Value
Case False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AY67").Font.Color = RGB(0, 112, 192)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'K [13 of 19]: WEIGHT--> If resident has a 6 month weight gain or loss that is more than 10% [BE30 = True], then text is red.
'BE30 = 6 month weight gain [AY68] is 10% or higher or 6 month weight loss [AY68] is 10% or higher.
'
Select Case Range("BE30").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AY68").Font.Color = RGB(255, 0, 0)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [14 of 19]: WEIGHT--> If resident does not have a 6 month weight gain or loss that is more than 10% [BE30 = False], then text is
'normal.
'BE30 = 6 month weight gain [AY68] is 10% or higher or 6 month weight loss [AY68] is 10% or higher.
'
Select Case Range("BE30").Value
Case False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AY68").Font.Color = RGB(0, 112, 192)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [15 of 19]: WEIGHT--> If resident has weight loss or weight gain (5% or in 30 days or 10% or more in 6 months) [BE31 = True],
'then prescribed [AP69] is visible.
'BE31 = weight loss (5% or more in 30 days or 10% or more in 6 months) [AJ67 = Y] or weight gain (5% or more in 30 days or 10% or
'more in 6 months) [AJ68 = Y]
'
Select Case Range("BE31").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP69").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [16 of 19]: WEIGHT--> If resident does not have weight loss or weight gain (5% or in 30 days or 10% or more in 6 months)
'[BE31 = False] or the cell is blank, then prescribed is hidden.
'BE31 = weight loss (5% or more in 30 days or 10% or more in 6 months) [AJ67 = Y] or weight gain (5% or more in 30 days or 10% or
'more in 6 months) [AJ68 = Y]
'
Select Case Range("BE31").Value
Case False
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP69").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [17 of 19]: IVF/TF--> If resident has not had IVF or TF prior to admission or while a resident [BE32 = True],  then total
'calories and total fluids [Y75:Y76 +AT75:AT76] are hidden.
'BE32 = No IVF while not a resident [AF71 = N] and while a resident [AM71 = N] + No TF while not a resident [AF71 = N] and while a
'resident [AM71 = N].
'
Select Case Range("BE32").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y75:Y76").NumberFormat = ";;;"
        Range("AM75:AM76").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [18 of 19]: IVF/TF--> No IVF while not a resident, [AF71], while a resident [AM71], no TF while not a resident [AF71, and while
'a resident [AM71] are blank [BE33 = True], then total calories and total fluids [Y75:Y76 +AT75:AT76] are hidden.
'BE33 = No IVF while not a resident, [AF71], while a resident [AM71], no TF while not a resident [AF71, and while a resident
'[AM71] are blank.
'
Select Case Range("BE33").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y75:Y76").NumberFormat = ";;;"
        Range("AM75:AM76").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K [19 of 19]: IVF/TF--> If resident had IVF or FT on admission, while not a resident, or while a resident [BE34 = True], then
'total calories and total fluids [Y75:Y76 +AT75:AT76] are visible.
'BE34 =  IVF or TF on admission [Y71 or Y72 = Y], while not a resident [AF71 or AF72 = Y], or while a resident [AM71 or AM72 = Y].
'
Select Case Range("BE34").Value
Case True
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y75:Y76").NumberFormat = "text"
        Range("AM75:AM76").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'K: IVF/TF--> Logic Check: If any cells in WHILE A RESIDENT are blank then the corresponding cell in on admission is blank.
'
Select Case Range("AM71").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y71").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AM72").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y72").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AM73").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y73").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AM74").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y74").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'L [1 of 2]: DENTAL--> If there are dental concerns [C72 = blank], then all options [D73:D79] are visible.
'
Select Case Range("C72").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D73:D79").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'L [2 of 2]: DENTAL--> If there are no dental concerns [C72 = checked], then options [D73:D79] are hidden.
'
Select Case Range("C72").Value
'
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D73:D79").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'M [1 of 6]: SKIN--> If resident has any PU/PI [C82 = Y], then all staging options [C83:C84 + H82:H84 + O82:O83] are visible.
Select Case Range("C82").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C83:C84").NumberFormat = "text"
        Range("H82:H84").NumberFormat = "text"
        Range("O82:O83").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'M [2 of 6]: SKIN--> If resident does not have any PU/PI [C82 = N] or the cell [C82] is blank, then all staging options
'[C83:C84 + H82:H84 + O82:O83] are hidden.
'
Select Case Range("C82").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C83:C84").NumberFormat = ";;;"
        Range("H82:H84").NumberFormat = ";;;"
        Range("O82:O83").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'M [3 of 6]: SKIN--> If resident does not have any other skin issues  [C86 = checked], then options [D87:D94] are hidden.
'
Select Case Range("C86").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D87:D94").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'M [4 of 6]: SKIN--> If resident does have skin issues or the cell [C86] is blank, then options [D87:D94] are visible.
'
Select Case Range("C86").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("D87:D94").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'M [5 of 6]: SKIN--> If there are no treatments [K86 = checked] then options [L87:L94] are hidden.
'
Select Case Range("K86").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("L87:L94").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'M [6 of 6]: SKIN--> If there are treatments or the cell [K86] is blank, then options [L87:L94] are visible.
'
Select Case Range("K86").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("L87:X94").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'N [1 of 14]: INJECTIONS--> If resident did not have any injections [Y77 = 0] then insulin [Z79] is hidden.
Select Case Range("Y78").Value
Case "0"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Z79").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [2 of 14]: INJECTIONS--> If resident received any injections [Y78 >0] or the cell [Y87} is blank, then insulin [Z79] is visible.
'
Select Case Range("Y78").Value
Case Is > 0, ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Z79").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [3 of 14]:INSULIN---> If resident did not receive any insulin [Y79 = 0] or the cell [Y79] is blank, then number of changes [Z80]
'is hidden.
'
Select Case Range("Y79").Value
Case "0", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Z80").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [4 of 14]:INSULIN--> If resident received any insulin [Y79 >0], then number of changes [Z80] is visible.
'
Select Case Range("Y79").Value
Case Is > 0
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Z80").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [5 of 14]: MEDICATIONS--> If resident did not take any medications [AD77 = checked] then all
'options [AE78:AE80 + AM77:AM80 + AU77:AU80] are hidden.
'
Select Case Range("AD77").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE78:AE80").NumberFormat = ";;;"
        Range("AM77:AM80").NumberFormat = ";;;"
        Range("AU77:AU80").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [6 of 14]:MEDICATIONS--> If resident took any medications or the cell [AD77] is blank, then all
'options [AE78:AE80 + AM77:AM80 + AU77:AU80] are visible.
'
Select Case Range("AD77").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AE78:AE80").NumberFormat = "text"
        Range("AM77:AM80").NumberFormat = "text"
        Range("AU77:AU80").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [7 of 14]: ANTIPSYCHOTICS--> If the resident did not receive any antipsychotics or if the cell [AC78] is blank, then
'frequency [Y81 + Z82:Z84], GDR [AH81], and contraindicated [AH83] are hidden.
'
Select Case Range("AC78").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y81").NumberFormat = ";;;"
        Range("Z82:Z84").NumberFormat = ";;;"
        Range("AH81").NumberFormat = ";;;"
        Range("AH83").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [8 of 14]: ANTIPSYCHOTICS--> If resident received an antipsychotic [AC78 = checked] then frequency [Y81 + Z82:Z84], GDR [AH81],
'and contraindicated [AH83] are visible.
'
Select Case Range("AC78").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y81").NumberFormat = "text"
        Range("Z82:Z84").NumberFormat = "text"
        Range("AH81").NumberFormat = "text"
        Range("AH83").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [9 of 14]: ANTIPSYCHOTICS--> If there was a GDR [AG81 = Y], then date [AG82] is visible.
'
Select Case Range("AG81").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG82").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [10 of 14]: ANTIPSYCHOTICS--> If there was not a GDR [AG81 = N] or the cell [AG81] is blank, then date [AG82] is hidden.
'
Select Case Range("AG81").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG82").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [11 of 14]: ANTIPSYCHOTICS--> If there is a documented contraindication to implementing a GDR [AG83 = Y], then date [AG84] is
'visible.
'
Select Case Range("AG83").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG84").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [12 of 14]: ANTIPSYCHOTICS--> If there is not a documented contraindication to implementing a GDR [AG83 = N] or the  cell [AG83]
'is blank, then date [AG84] is hidden.
'
Select Case Range("AG83").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG84").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [13 of 14]: MEDICATION ISSUES--> If there were significant medication issues [AY82 = Y], then follow-up with MD [AP83] is
'visible.
'
Select Case Range("AY82").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP83").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'N [14 of 14]: MEDICATION ISSUES--> If there were no significant medication issues [AY82 = N] or the cell [AY82] is blank, then
'follow-up with MD [AP83] is hidden.
'
Select Case Range("AY82").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AP83").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'
'
'O [1 of 4]: INFLUENZA--> If resident received the influenza vaccination in-facility [G96 = Y], date [C97] is visible.
'
Select Case Range("G96").Value
Case "Y"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C97").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'O [2 of 4]: INFLUENZA--> If resident did not receive the influenza vaccination in-facility [G96 = N] or the cell [G96] is blank,
'then date [C97]is hidden.
'
Select Case Range("G96").Value
Case "N", ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("C97").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'O [3 of 4]: SPECIAL TREATMENTS--> If resident did not receive any special treatments [Y86 = checked], then options [Y87:Y99] are
'hidden.
'
Select Case Range("Y86").Value
Case "P"
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y87:Y99").NumberFormat = ";;;"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'O [4 of 4]: SPECIAL TREATMENTS--> If resident received any special treatments or the cell [Y86] is blank, then options [Y87:Y99]
'are visible.
'
Select Case Range("Y86").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("Y87:Y99").NumberFormat = "text"
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
'
'O: Logic Check: If any special treatments while a resident are blank then their corresponding cells for ON ADMISSION are blank.
'
Select Case Range("AO87").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG87").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO88").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG88").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO89").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG89").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO90").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG90").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO91").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG91").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO92").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG92").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO93").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG93").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO94").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG94").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO95").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG95").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO96").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG96").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select
Select Case Range("AO99").Value
Case ""
    Application.ScreenUpdating = False
    Application.EnableEvents = False
        Range("AG99").Value = ""
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Select



End Sub


This problem is that it makes everything slow. Anytime I make any changes to the worksheet (type anything in, delete anything) it takes a second to process it. It weirdly enough, makes Excel slow as well. There is a lag. So if I try to minimize the window, even that takes a second to process. It does not affect any other Excel windows I have open. The only thing that doesn't seem to be affected is the macro buttons. They still work lickity-split. Any ideas on how I can speed this up? Is there maybe a way to be more efficient in my coding? Or am I using enable.events and screen.updating incorrectly?

Any help is welcomed.
 
Sort by date Sort by votes
I believe putting everything into the worksheet change event is not optimal.
It's better to break it down into smaller subs to make it easier to manage.
For example:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim Changed As Range, c As Range
    Dim cellValue As Variant

    ' Part 1: Convert the cells to uppercase
    Set Changed = Intersect(Target, Union(Range("AI13:AI14,H17,P17:P19,R16,T16:T19,AA17:AA18,AI16,G21,G24,S20:S22,AA20:AA22,AH21:AH25"), _
        Range("AP21:AP24,AK28:AL28,AK30:AL30,AK32:AL32,AP28:AP31,AX32,AY44,AY48,AP45:AP47,AY48,AP49:AP54,AP56:AP60,AY64,AP65,AU65,W66,C38:C65"), _
        Range("V38:V65,W66,C67:C70,AJ67:AJ68,AV69,Y71:AW74,C72:C79,L80,R80,C81:C82,C86:C94,K86:K94,AD77,AC77:AD80,AK77:AL80,AS77:AT80"), _
        Range("Y82:Y84,AG81,AG83,G96,G98,Y86,AG88,AG90:AG92,AG95,AG97:AG98,AO87:AU99")))

    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = UCase(c.Value)  ' Convert value to uppercase
        Next c
    End If

    ' Part 2: Convert the cells to proper case (first letter capitalized)
    Set Changed = Intersect(Target, Range("J13,H37"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = StrConv(c.Value, vbProperCase)  ' Convert value to proper case
        Next c
    End If

    ' Part 3: Set value "P" for non-empty cells
    Set Changed = Intersect(Target, Range("S20:S22,AA20:AA22,AH21:AH25,C38:C65,V38:V65,AY44,AY48,W66,AD77,AC78:AC80,AK77:AK80,AS77:AS80,Y86,C86,K86,C72"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            If c.Value <> "" Then  ' Check if the cell is not empty
                c.Value = "P"  ' Set value to "P"
            End If
        Next c
    End If

    ' Part 4: Handle specific conditions
    Call HandleMCDConditions
    Call HandleLanguageConditions
    Call HandlePASRRConditions
    Call HandleBehaviorConditions
    Call HandleGGConditions
    Call HandleCatheterConditions
    Call HandlePainConditions
    Call HandleSOBConditions
    Call HandleOtherConditions
    Call HandleFallsConditions
    Call HandleSurgeryConditions
    Call HandleSwallowConditions
    Call HandleWeightConditions
    Call HandleIVFTFConditions
    Call HandleDentalConditions
    Call HandleSkinConditions
    Call HandleInjectionConditions
    Call HandleMedicationConditions
    Call HandleInfluenzaConditions
    Call HandleSpecialTreatments

ExitHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub HandleMCDConditions()
    Dim cellValue As Variant
    cellValue = Range("AI14").Value

    Select Case cellValue
        Case "NO"
            With Range("AI14")
                .Interior.Color = RGB(255, 255, 0)  ' Yellow background for "NO"
                .Font.Color = RGB(255, 0, 0)  ' Red font for "NO"
            End With
        Case ""
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for empty cell
                .Font.Color = RGB(0, 112, 192)  ' Blue font for empty cell
            End With
        Case Else
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for other values
                .Font.Color = RGB(0, 112, 192)  ' Blue font for other values
            End With
    End Select
End Sub

Private Sub HandleLanguageConditions()
    Dim cellValue As Variant
    cellValue = Range("I17").Value

    Select Case cellValue
        Case "English"
            With Range("H17")
                .Value = "N"  ' Set value "N" for English language
                .NumberFormat = "text"  ' Set number format as text
            End With
        Case ""
            Range("H17").NumberFormat = ";;;"  ' Hide value for empty language cell
    End Select
End Sub

Private Sub HandlePASRRConditions()
    Dim cellValue As Variant
    cellValue = Range("R16").Value

    Select Case cellValue
        Case "N", ""
            Range("Q17:Q19").NumberFormat = ";;;"  ' Hide value for "N" or empty in PASRR
        Case "Y"
            Range("Q17:Q19").NumberFormat = "text"  ' Set number format as text for "Y"
    End Select

    cellValue = Range("T16").Value
    Select Case cellValue
        Case "N"
            Range("U17:U18").NumberFormat = ";;;"  ' Hide value for "N"
            Range("AB17:AB18").NumberFormat = ";;;"  ' Hide value for "N"
        Case "Y", ""
            Range("U17:U18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
            Range("AB17:AB18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
    End Select
End Sub
' Other condition handling functions can be added similarly...
 
Upvote 0
Solution
bebo021999 said:
I believe putting everything into the worksheet change event is not optimal.
It's better to break it down into smaller subs to make it easier to manage.
For example:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim Changed As Range, c As Range
    Dim cellValue As Variant

    ' Part 1: Convert the cells to uppercase
    Set Changed = Intersect(Target, Union(Range("AI13:AI14,H17,P17:P19,R16,T16:T19,AA17:AA18,AI16,G21,G24,S20:S22,AA20:AA22,AH21:AH25"), _
        Range("AP21:AP24,AK28:AL28,AK30:AL30,AK32:AL32,AP28:AP31,AX32,AY44,AY48,AP45:AP47,AY48,AP49:AP54,AP56:AP60,AY64,AP65,AU65,W66,C38:C65"), _
        Range("V38:V65,W66,C67:C70,AJ67:AJ68,AV69,Y71:AW74,C72:C79,L80,R80,C81:C82,C86:C94,K86:K94,AD77,AC77:AD80,AK77:AL80,AS77:AT80"), _
        Range("Y82:Y84,AG81,AG83,G96,G98,Y86,AG88,AG90:AG92,AG95,AG97:AG98,AO87:AU99")))

    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = UCase(c.Value)  ' Convert value to uppercase
        Next c
    End If

    ' Part 2: Convert the cells to proper case (first letter capitalized)
    Set Changed = Intersect(Target, Range("J13,H37"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = StrConv(c.Value, vbProperCase)  ' Convert value to proper case
        Next c
    End If

    ' Part 3: Set value "P" for non-empty cells
    Set Changed = Intersect(Target, Range("S20:S22,AA20:AA22,AH21:AH25,C38:C65,V38:V65,AY44,AY48,W66,AD77,AC78:AC80,AK77:AK80,AS77:AS80,Y86,C86,K86,C72"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            If c.Value <> "" Then  ' Check if the cell is not empty
                c.Value = "P"  ' Set value to "P"
            End If
        Next c
    End If

    ' Part 4: Handle specific conditions
    Call HandleMCDConditions
    Call HandleLanguageConditions
    Call HandlePASRRConditions
    Call HandleBehaviorConditions
    Call HandleGGConditions
    Call HandleCatheterConditions
    Call HandlePainConditions
    Call HandleSOBConditions
    Call HandleOtherConditions
    Call HandleFallsConditions
    Call HandleSurgeryConditions
    Call HandleSwallowConditions
    Call HandleWeightConditions
    Call HandleIVFTFConditions
    Call HandleDentalConditions
    Call HandleSkinConditions
    Call HandleInjectionConditions
    Call HandleMedicationConditions
    Call HandleInfluenzaConditions
    Call HandleSpecialTreatments

ExitHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub HandleMCDConditions()
    Dim cellValue As Variant
    cellValue = Range("AI14").Value

    Select Case cellValue
        Case "NO"
            With Range("AI14")
                .Interior.Color = RGB(255, 255, 0)  ' Yellow background for "NO"
                .Font.Color = RGB(255, 0, 0)  ' Red font for "NO"
            End With
        Case ""
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for empty cell
                .Font.Color = RGB(0, 112, 192)  ' Blue font for empty cell
            End With
        Case Else
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for other values
                .Font.Color = RGB(0, 112, 192)  ' Blue font for other values
            End With
    End Select
End Sub

Private Sub HandleLanguageConditions()
    Dim cellValue As Variant
    cellValue = Range("I17").Value

    Select Case cellValue
        Case "English"
            With Range("H17")
                .Value = "N"  ' Set value "N" for English language
                .NumberFormat = "text"  ' Set number format as text
            End With
        Case ""
            Range("H17").NumberFormat = ";;;"  ' Hide value for empty language cell
    End Select
End Sub

Private Sub HandlePASRRConditions()
    Dim cellValue As Variant
    cellValue = Range("R16").Value

    Select Case cellValue
        Case "N", ""
            Range("Q17:Q19").NumberFormat = ";;;"  ' Hide value for "N" or empty in PASRR
        Case "Y"
            Range("Q17:Q19").NumberFormat = "text"  ' Set number format as text for "Y"
    End Select

    cellValue = Range("T16").Value
    Select Case cellValue
        Case "N"
            Range("U17:U18").NumberFormat = ";;;"  ' Hide value for "N"
            Range("AB17:AB18").NumberFormat = ";;;"  ' Hide value for "N"
        Case "Y", ""
            Range("U17:U18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
            Range("AB17:AB18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
    End Select
End Sub
' Other condition handling functions can be added similarly...
Click to expand...
I reworked all the code with your suggestions and it of course works perfectly! Thank you so much!
 
Upvote 0
bebo021999 said:
I believe putting everything into the worksheet change event is not optimal.
It's better to break it down into smaller subs to make it easier to manage.
For example:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ExitHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim Changed As Range, c As Range
    Dim cellValue As Variant

    ' Part 1: Convert the cells to uppercase
    Set Changed = Intersect(Target, Union(Range("AI13:AI14,H17,P17:P19,R16,T16:T19,AA17:AA18,AI16,G21,G24,S20:S22,AA20:AA22,AH21:AH25"), _
        Range("AP21:AP24,AK28:AL28,AK30:AL30,AK32:AL32,AP28:AP31,AX32,AY44,AY48,AP45:AP47,AY48,AP49:AP54,AP56:AP60,AY64,AP65,AU65,W66,C38:C65"), _
        Range("V38:V65,W66,C67:C70,AJ67:AJ68,AV69,Y71:AW74,C72:C79,L80,R80,C81:C82,C86:C94,K86:K94,AD77,AC77:AD80,AK77:AL80,AS77:AT80"), _
        Range("Y82:Y84,AG81,AG83,G96,G98,Y86,AG88,AG90:AG92,AG95,AG97:AG98,AO87:AU99")))

    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = UCase(c.Value)  ' Convert value to uppercase
        Next c
    End If

    ' Part 2: Convert the cells to proper case (first letter capitalized)
    Set Changed = Intersect(Target, Range("J13,H37"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            c.Value = StrConv(c.Value, vbProperCase)  ' Convert value to proper case
        Next c
    End If

    ' Part 3: Set value "P" for non-empty cells
    Set Changed = Intersect(Target, Range("S20:S22,AA20:AA22,AH21:AH25,C38:C65,V38:V65,AY44,AY48,W66,AD77,AC78:AC80,AK77:AK80,AS77:AS80,Y86,C86,K86,C72"))
    If Not Changed Is Nothing Then
        For Each c In Changed
            If c.Value <> "" Then  ' Check if the cell is not empty
                c.Value = "P"  ' Set value to "P"
            End If
        Next c
    End If

    ' Part 4: Handle specific conditions
    Call HandleMCDConditions
    Call HandleLanguageConditions
    Call HandlePASRRConditions
    Call HandleBehaviorConditions
    Call HandleGGConditions
    Call HandleCatheterConditions
    Call HandlePainConditions
    Call HandleSOBConditions
    Call HandleOtherConditions
    Call HandleFallsConditions
    Call HandleSurgeryConditions
    Call HandleSwallowConditions
    Call HandleWeightConditions
    Call HandleIVFTFConditions
    Call HandleDentalConditions
    Call HandleSkinConditions
    Call HandleInjectionConditions
    Call HandleMedicationConditions
    Call HandleInfluenzaConditions
    Call HandleSpecialTreatments

ExitHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Private Sub HandleMCDConditions()
    Dim cellValue As Variant
    cellValue = Range("AI14").Value

    Select Case cellValue
        Case "NO"
            With Range("AI14")
                .Interior.Color = RGB(255, 255, 0)  ' Yellow background for "NO"
                .Font.Color = RGB(255, 0, 0)  ' Red font for "NO"
            End With
        Case ""
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for empty cell
                .Font.Color = RGB(0, 112, 192)  ' Blue font for empty cell
            End With
        Case Else
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)  ' Light green background for other values
                .Font.Color = RGB(0, 112, 192)  ' Blue font for other values
            End With
    End Select
End Sub

Private Sub HandleLanguageConditions()
    Dim cellValue As Variant
    cellValue = Range("I17").Value

    Select Case cellValue
        Case "English"
            With Range("H17")
                .Value = "N"  ' Set value "N" for English language
                .NumberFormat = "text"  ' Set number format as text
            End With
        Case ""
            Range("H17").NumberFormat = ";;;"  ' Hide value for empty language cell
    End Select
End Sub

Private Sub HandlePASRRConditions()
    Dim cellValue As Variant
    cellValue = Range("R16").Value

    Select Case cellValue
        Case "N", ""
            Range("Q17:Q19").NumberFormat = ";;;"  ' Hide value for "N" or empty in PASRR
        Case "Y"
            Range("Q17:Q19").NumberFormat = "text"  ' Set number format as text for "Y"
    End Select

    cellValue = Range("T16").Value
    Select Case cellValue
        Case "N"
            Range("U17:U18").NumberFormat = ";;;"  ' Hide value for "N"
            Range("AB17:AB18").NumberFormat = ";;;"  ' Hide value for "N"
        Case "Y", ""
            Range("U17:U18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
            Range("AB17:AB18").NumberFormat = "text"  ' Set number format as text for "Y" or empty
    End Select
End Sub
' Other condition handling functions can be added similarly...
Click to expand...
So the sheet works wonderfully...when it is in a workbook by itself. When I have more than one sheet (copy) in a workbook it gets super laggy again. Because of this, I have this saved as a macro-enabled template and just "add" the completed worksheet to another workbook, (this workbook holds all of my completed forms) once I have completed it, so that there is only one sheet that I am working on at a time. I don't have to do much editing to it once I have completed it but by the end of the month I can have upwards of 20-25 of these in one workbook. Any suggestions? If you need to see my updated coding (maybe I made a mistake?), let me know and I will upload it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Run-time error '13': Type mismatch with Ucase
Replies
3
Views
57
Peter_SSs
Peter_SSs
I
  • Question Question
Advice for Could Not Find The Specific Object message
2
Replies
12
Views
240
ipbr21054
I
K
  • Solved
Undo Stack gets cleared running VBA - Possible Solution to fix this?
Replies
5
Views
627
kellman
K
R
  • Question Question
Required Transposed Values instead of Row Items of Duplicate Invoice no with Each GSTIN which is displaying the SUM of 12+18+28
Replies
1
Views
111
rk_rk
R
A
  • Solved
Need help with worksheet/conditional formatting/macros please
Replies
7
Views
103
Aphten
A

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top