Excel is getting slower as I add more sheets

Aphten

New Member
Joined
Jul 24, 2024
Messages
16
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.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Dim Changed As Range, c As Range
    Dim CellValue As Variant
'
'Convert cells to UpperCase
'
    Set Changed = Intersect(Target, Union(Range("AI13:AI14,H17,P17:P19,R16,T16:T19,AA17:AA18"), _
    Range("G21,G24,S20:S22,AA20:AA22,AH21:AH25,AP21:AP24,AK28:AL28,AK30:AL30,AK32:AL32"), _
    Range("AP28:AP31,AX32,AY44,AY48,AP45:AP47,AY48,AP49:AP54,AP56:AP60,AY64,AP65,AU65,W66"), _
    Range("C38:C65,V38:V65,W66,C67:C70,AJ67:AJ68,AV69,Y71:AW74,C72:C79,L80,R80,C81:C82"), _
    Range("C86:C94,K86:K94,AD77,AC77:AD80, AK77:AL80,AS77:AT80,Y82:Y84,AG81,AG83,AY82,G96,G98"), _
    Range("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)
            Next c
    End If
'
'Convert cells to ProperCase
'
    Set Changed = Intersect(Target, Range("J13,H37"))
    If Not Changed Is Nothing Then
            For Each c In Changed
              c.Value = StrConv(c.Value, vbProperCase)
            Next c
    End If
'
'Convert cells to check mark
'
    Set Changed = Intersect(Target, Union(Range("S20:S22,AA20:AA22,AH21:AH25,C38:C65,V38:V65,AY44,AY48"), _
    Range("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
              c.Value = "P"
            End If
            Next c
    End If
    
    Call MCD_Conditions
    Call Language_Conditions
    Call PASRR_Conditions
    Call Behavior_Conditions
    Call GG_Conditions
    Call Catheter_Conditions
    Call Pain_Conditions
    Call SwallowingNutritional_Conditions
    Call IVF_TF_LogicCheck
    Call Dental_conditions
    Call Skin_Conditions
    Call Medication_Conditions
    Call Vaccinations_and_SpecialTreatment_Conditions
    Call SpecailTreatment_LogicCheck
    
Exithandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Private Sub MCD_Conditions()

Dim CellValue As Variant
CellValue = Range("AI14")
'A: MCD [1 of 3]--> If the resident does not have MCD [AI14=NO], then the cell is highlighted.
    Select Case CellValue
    
        Case "NO"
            With Range("AI14")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(255, 0, 0)
            End With
'A: MCD [2 of 3]--> If the MCD # cell [AI14] is blank, then the cell fill matches and font is normal.
        Case ""
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)
                .Font.Color = RGB(0, 112, 192)
            End With
'A: MCD [3 of 3]--> If the MCD # cell [AI14] has a MCD number, then the cell fill matches and font is normal.
        Case Is <> "NO"
            With Range("AI14")
                .Interior.Color = RGB(226, 239, 218)
                .Font.Color = RGB(0, 112, 192)
            End With
    End Select
End Sub
Private Sub Language_Conditions()

Dim CellValue As Variant
CellValue = Range("I17")
'A: LANGUAGE [1 of 3]--> If language is English [I17=English] then resident does not need an interpreter [H17=N].
    Select Case CellValue
        Case "English"
            With Range("H17")
                .Value = "N"
                .NumberFormat = "text"
            End With
'A: Language [2 of 3]---> If language cell [I17] is blank, then interpreter cell [H17] is blank.
        Case ""
            Range("H17").NumberFormat = ";;;"
'A: Language [3 of 3]--> If language cell [I17] is not blank, then interpreter cell [H17] is visible.
        Case Is <> ""
            Range("H17").NumberFormat = "text"
    End Select
End Sub
Private Sub PASRR_Conditions()

Dim CellValue As Variant
CellValue = Range("R16")
'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 CellValue
        Case "N", ""
            Range("Q17:Q19").NumberFormat = ";;;"
'A: PASRR [2 of 4]--> If resident has a Level II PASRR [R16=Y], then SMI, ID, and other [Q17:Q19] are visible.
        Case "Y"
            Range("Q17:Q19").NumberFormat = "text"
    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.
    CellValue = Range("T16").Value
    Select Case CellValue
        Case "N"
            Range("U17:U18").NumberFormat = ";;;"
            Range("AB17:AB18").NumberFormat = ";;;"
'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.
        Case "Y", ""
            Range("U17:U18").NumberFormat = "text"
            Range("AB17:AB18").NumberFormat = "text"
    End Select
End Sub
Private Sub Behavior_Conditions()

Dim CellValue As Variant
CellValue = Range("G24")
'E: BEHAVIORS [1 of 2] 'If resident had behaviors [G24=Y], then days [C25] is visible.
    Select Case CellValue
        Case "Y"
            Range("C25").NumberFormat = "text"
'E: BEHAVIORS [2 of 2]'  If the resident did not have behaviors [G24=N] or the cell is blank, then days [C25] is hidden.
        Case "N", ""
            Range("C25").NumberFormat = ";;;"
    End Select
End Sub
Private Sub GG_Conditions()
Dim CellValue As Variant
CellValue = Range("Q20")
'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 CellValue
        Case "NO"
            With Range("Q20")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(255, 0, 0)
                .Font.Bold = True
            End With
'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.
        Case "UDA", "Note", ""
            With Range("Q20")
                .Interior.Color = RGB(237, 237, 237)
                .Font.Color = RGB(0, 112, 192)
                .Font.Bold = False
            End With
    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.
CellValue = Range("S20")
    Select Case CellValue
        Case "P"
            Range("T21:T22").NumberFormat = ";;;"
            Range("AB20:AB22").NumberFormat = ";;;"
'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.
        Case ""
            Range("T21:T22 ").NumberFormat = "text"
            Range("AB20:AB22").NumberFormat = "text"
    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.
CellValue = Range("AH21")
    Select Case CellValue
        Case "P"
            Range("AI22:AI25").NumberFormat = ";;;"
'GG [6 of 17]: CURRENT DEVICES--> If resident used any device during the lookback period [AH21=blank], then options are
'visible.
        Case ""
            Range("AI21:AI25").NumberFormat = "text"
    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.
CellValue = Range("BE13")
    Select Case CellValue
        Case True
            Range("AD29:AD31").Value = Range("AD28").Value
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.
CellValue = Range("BE14")
    Select Case CellValue
        Case True
            Range("AE29:AE31").Value = Range("AE28").Value
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.
CellValue = Range("AD28")
    Select Case CellValue
        Case ""
            Range("AD29:AD31").Value = ""
    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.
CellValue = Range("AE28")
    Select Case CellValue
        Case ""
            Range("AE29:AE31").Value = ""
    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.
CellValue = Range("BE15")
    Select Case CellValue
        Case True
            Range("AD33:AD34").Value = Range("AD32").Value
    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.
CellValue = Range("BE16")
    Select Case CellValue
        Case True
            Range("AE33:AE34").Value = Range("AE32").Value
    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.
CellValue = Range("AD32")
    Select Case Range("AD32").Value
        Case ""
            Range("AD33:AD34").Value = ""
    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.
CellValue = Range("AE32")
    Select Case CellValue
        Case ""
            Range("AE33:AE34").Value = ""
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].
CellValue = Range("BE19")
    Select Case CellValue
        Case True
            Range("AM29:AM32").NumberFormat = ";;;"
    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]
CellValue = Range("BE20")
    Select Case CellValue
        Case True
            Range("AM29:AM32").NumberFormat = ";;;"
    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]
CellValue = Range("BE21")
    Select Case CellValue
        Case True
            Range("AM29:AM32").NumberFormat = "text"
    End Select
End Sub
Private Sub Catheter_Conditions()
Dim CellVallue As Variant
'H [1 of 3]: CATHETER--> If resident has a catheter [AP21 = Y], then diagnosis [AV21] is visible.
CellValue = Range("AP21")
    Select Case CellValue
        Case "Y"
            Range("AV21").NumberFormat = "text"
'H [2 of 3]: CATHETER--> If they do not have an indwelling catheter [AP21 = N] or the cell is blank, then diagnosis [AV21]
'is hidden.
        Case "N", ""
            Range("AV21").NumberFormat = ";;;"
    End Select
'H [3 of 3]: CATHETER--> If there is no diagnosis [AV22 = NO], then cell [AV22] is highlighted and text is red. If not, then
'cell [AV22] is not highlighted and font is normal.
CellValue = Range("AV22")
    Select Case CellValue
        Case "NO"
            With Range("AV22")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(255, 0, 0)
            End With
        Case Else
            With Range("AV22")
                .Interior.Color = RGB(215, 175, 255)
                .Font.Color = RGB(0, 112, 192)
            End With
    End Select
End Sub
Private Sub Pain_Conditions()
Dim CellValue As Variant
'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.
CellValue = Range("AP28")
    Select Case CellValue
        Case "Y"
            Range("AP32:AW32").NumberFormat = "text"
            Range("AP38:AP43").NumberFormat = ";;;"
'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.
        Case "N"
        Range("AP38:AP43").NumberFormat = "text"
        Range("AP32:AW32").NumberFormat = ";;;"
'J [5 of 15]: PAIN--> If interviewable cell [AP28] is blank, then neither resident interview [AP32:AW32] or staff
'interview [AP38:AP43] are visible.
        Case ""
            Range("AP32:AW32").NumberFormat = ";;;"
            Range("AP38:AP43").NumberFormat = ";;;"
    End Select
'J [2 of 15]: PAIN--> If resident reports pain [AX32 = Y], then rest of the pain interview [AP33:AP37] is visible.
CellValue = Range("AX32")
    Select Case CellValue
        Case "Y"
            Range("AP33:AP37").NumberFormat = "text"
'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.
        Case "N", ""
            Range("AP33:AP37").NumberFormat = ";;;"
    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.
CellValue = Range("AY44")
    Select Case CellValue
        Case "P"
            Range("AQ45:AQ47").NumberFormat = ";;;"
'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.
        Case ""
            Range("AQ45:AQ47").NumberFormat = "text"
    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.
CellValue = Range("AY48")
    Select Case CellValue
        Case "P"
            Range("AQ49:AQ54").NumberFormat = ";;;"
'J [9 of 15]: OTHER CONDITIONS--> If the none option for other conditions [AY48] is blank then all of the options are
'visible.
        Case ""
            Range("AQ49:AQ54").NumberFormat = "text"
    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.
CellValue = Range("AP56")
    Select Case CellValue
        Case "Y"
            Range("AR57:AR59").NumberFormat = "text"
'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.
        Case "N", ""
            Range("AR57:AR59").NumberFormat = ";;;"
    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.
CellValue = Range("AP60")
    Select Case CellValue
        Case "Y"
            Range("AR61:AR63").NumberFormat = "text"
'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.
    Case "N", ""
            Range("AR61:AR63").NumberFormat = ";;;"
    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.
CellValue = Range("AY64")
    Select Case CellValue
        Case "Y"
            Range("AQ65").NumberFormat = "text"
            Range("AV65").NumberFormat = "text"
'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.
        Case "N", ""
            Range("AQ65").NumberFormat = ";;;"
            Range("AV65").NumberFormat = ";;;"
    End Select
End Sub
Private Sub SwallowingNutritional_Conditions()
Dim CellValue As Variant
'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.
CellValue = Range("W66")
    Select Case CellValue
        Case ""
            Range("D67:D70").NumberFormat = "text"
'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.
        Case "P"
            Range("D67:D70").NumberFormat = ";;;"
    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].
CellValue = Range("BE24")
    Select Case CellValue
        Case True
            With Range("Y69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Bold = True
                .Font.Color = RGB(255, 0, 0)
            End With
            With Range("AC69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(0, 112, 192)
            End With
            With Range("AE69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(255, 0, 0)
                .HorizontalAlignment = xlLeft
                .Value = "  <--- ???"
            End With
    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.
CellValue = Range("BE25")
    Select Case CellValue
        Case True
            With Range("Y69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Bold = False
                .Font.Color = RGB(0, 0, 0)
            End With
            With Range("AC69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Color = RGB(0, 112, 192)
            End With
            With Range("AE69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Color = RGB(0, 112, 192)
                .HorizontalAlignment = xlCenter
                .Value = ""
            End With
    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].
CellValue = Range("BE26")
    Select Case CellValue
        Case True
            With Range("Y69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Bold = True
                .Font.Color = RGB(0, 180, 0)
            End With
            With Range("AC69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(0, 180, 0)
            End With
            With Range("AE69")
                .Interior.Color = RGB(255, 255, 0)
                .Font.Color = RGB(0, 180, 0)
                .HorizontalAlignment = xlCenter
                .Value = "<--- Morbid Obesity???"
            End With
    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.
CellValue = Range("BE28")
    Select Case CellValue
        Case True
            With Range("Y69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Bold = False
                .Font.Color = RGB(0, 0, 0)
            End With
            With Range("AC69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Color = RGB(0, 112, 192)
            End With
            With Range("AE69")
                .Interior.Color = RGB(255, 201, 255)
                .Font.Color = RGB(0, 180, 0)
                .HorizontalAlignment = xlCenter
                .Value = ""
            End With
    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.
CellValue = Range("AV67")
    Select Case CellValue
        Case ""
                Range("AV67").NumberFormat = "0.0"
                Range("AP67").NumberFormat = "text"
'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.
        Case "N/A"
            Range("AP67").NumberFormat = ";;;"
            Range("AV67").NumberFormat = ";;;"
    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.
CellValue = Range("AV68")
    Select Case CellValue
        Case ""
            Range("AV68").NumberFormat = "0.0"
            Range("AP68").NumberFormat = "text"
'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.
        Case "N/A"
            Range("AP68").NumberFormat = ";;;"
            Range("AV68").NumberFormat = ";;;"
    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
CellValue = Range("BE29")
    Select Case CellValue
        Case True
            Range("AY67").Font.Color = RGB(255, 0, 0)
'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.
        Case False
            Range("AY67").Font.Color = RGB(0, 112, 192)
    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.
CellValue = Range("BE30")
    Select Case CellValue
        Case True
            Range("AY68").Font.Color = RGB(255, 0, 0)
'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.
        Case False
            Range("AY68").Font.Color = RGB(0, 112, 192)
    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]
CellValue = Range("BE31")
    Select Case CellValue
        Case True
            Range("AP69").NumberFormat = "text"
'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]
        Case False
            Range("AP69").NumberFormat = ";;;"
    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].
CellValue = Range("BE32")
    Select Case CellValue
        Case True
            Range("Y75:Y76").NumberFormat = ";;;"
            Range("AM75:AM76").NumberFormat = ";;;"
    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.
CellValue = Range("BE33")
    Select Case CellValue
        Case True
            Range("Y75:Y76").NumberFormat = ";;;"
            Range("AM75:AM76").NumberFormat = ";;;"
    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].
CellValue = Range("BE34")
    Select Case CellValue
        Case True
            Range("Y75:Y76").NumberFormat = "text"
            Range("AM75:AM76").NumberFormat = "text"
    End Select
End Sub
Private Sub IVF_TF_LogicCheck()
Dim CellValue As Variant
'K: IVF/TF--> Logic Check: If any cells in WHILE A RESIDENT are blank then the corresponding cell in on admission is
'blank.
CellValue = Range("AM71")
    Select Case CellValue
        Case ""
            Range("Y71").Value = ""
    End Select
CellValue = Range("AM72")
    Select Case CellValue
        Case ""
            Range("Y72").Value = ""
    End Select
CellValue = Range("AM73")
    Select Case CellValue
        Case ""
            Range("Y73").Value = ""
    End Select
CellValue = Range("AM74")
    Select Case CellValue
        Case ""
            Range("Y74").Value = ""
    End Select
End Sub
Private Sub Dental_conditions()
Dim CellValue As Variant
'L [1 of 2]: DENTAL--> If there are dental concerns [C72 = blank], then all options [D73:D79] are visible.
CellValue = Range("C72")
    Select Case CellValue
        Case ""
            Range("D73:D79").NumberFormat = "text"
'L [2 of 2]: DENTAL--> If there are no dental concerns [C72 = checked], then options [D73:D79] are hidden.
        Case "P"
            Range("D73:D79").NumberFormat = ";;;"
    End Select
End Sub
Private Sub Skin_Conditions()
Dim CellValue As Variant
'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.
CellValue = Range("C82")
    Select Case CellValue
        Case "Y"
            Range("C83:C84").NumberFormat = "text"
            Range("H82:H84").NumberFormat = "text"
            Range("O82:O83").NumberFormat = "text"
'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.
        Case "N", ""
            Range("C83:C84").NumberFormat = ";;;"
            Range("H82:H84").NumberFormat = ";;;"
            Range("O82:O83").NumberFormat = ";;;"
    End Select
'M [3 of 6]: SKIN--> If resident does not have any other skin issues  [C86 = checked], then options [D87:D94] are hidden.
CellValue = Range("C86")
    Select Case CellValue
        Case "P"
            Range("D87:D94").NumberFormat = ";;;"
'M [4 of 6]: SKIN--> If resident does have skin issues or the cell [C86] is blank, then options [D87:D94] are visible.
        Case ""
            Range("D87:D94").NumberFormat = "text"
    End Select
'M [5 of 6]: SKIN--> If there are no treatments [K86 = checked] then options [L87:L94] are hidden.
CellValue = Range("K86")
    Select Case CellValue
        Case "P"
            Range("L87:L94").NumberFormat = ";;;"
'M [6 of 6]: SKIN--> If there are treatments or the cell [K86] is blank, then options [L87:L94] are visible.
        Case ""
            Range("L87:X94").NumberFormat = "text"
    End Select
End Sub
Private Sub Medication_Conditions()
Dim CellValue As Variant
'N [1 of 14]: INJECTIONS--> If resident did not have any injections [Y77 = 0] then insulin [Z79] is hidden.
CellValue = Range("Y78")
    Select Case CellValue
        Case "0"
            Range("Z79").NumberFormat = ";;;"
'N [2 of 14]: INJECTIONS--> If resident received any injections [Y78 >0] or the cell [Y87} is blank, then insulin [Z79]
'is visible.
        Case Is > 0, ""
            Range("Z79").NumberFormat = "text"
    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.
CellValue = Range("Y79")
    Select Case CellValue
        Case "0", ""
            Range("Z80").NumberFormat = ";;;"
'N [4 of 14]:INSULIN--> If resident received any insulin [Y79 >0], then number of changes [Z80] is visible.
        Case Is > 0
            Range("Z80").NumberFormat = "text"
    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.
CellValue = Range("AD77")
    Select Case CellValue
        Case "P"
            Range("AE78:AE80").NumberFormat = ";;;"
            Range("AM77:AM80").NumberFormat = ";;;"
            Range("AU77:AU80").NumberFormat = ";;;"
'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.
        Case ""
            Range("AE78:AE80").NumberFormat = "text"
            Range("AM77:AM80").NumberFormat = "text"
            Range("AU77:AU80").NumberFormat = "text"
    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.
CellValue = Range("AC78")
    Select Case CellValue
        Case ""
            Range("Y81").NumberFormat = ";;;"
            Range("Z82:Z84").NumberFormat = ";;;"
            Range("AH81").NumberFormat = ";;;"
            Range("AH83").NumberFormat = ";;;"
'N [8 of 14]: ANTIPSYCHOTICS--> If resident received an antipsychotic [AC78 = checked] then frequency [Y81 + Z82:Z84],
'GDR [AH81], and contraindicated [AH83] are visible.
        Case "P"
            Range("Y81").NumberFormat = "text"
            Range("Z82:Z84").NumberFormat = "text"
            Range("AH81").NumberFormat = "text"
            Range("AH83").NumberFormat = "text"
    End Select
'N [9 of 14]: ANTIPSYCHOTICS--> If there was a GDR [AG81 = Y], then date [AG82] is visible.
CellValue = Range("AG81")
    Select Case CellValue
        Case "Y"
            Range("AG82").NumberFormat = "text"
'N [10 of 14]: ANTIPSYCHOTICS--> If there was not a GDR [AG81 = N] or the cell [AG81] is blank, then date [AG82] is
'hidden.
        Case "N", ""
            Range("AG82").NumberFormat = ";;;"
End Select
'N [11 of 14]: ANTIPSYCHOTICS--> If there is a documented contraindication to implementing a GDR [AG83 = Y], then date
'[AG84] is visible.
CellValue = Range("AG83")
    Select Case CellValue
        Case "Y"
            Range("AG84").NumberFormat = "text"
'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.
        Case "N", ""
            Range("AG84").NumberFormat = ";;;"
    End Select
'N [13 of 14]: MEDICATION ISSUES--> If there were significant medication issues [AY82 = Y], then follow-up with MD [AP83]
'is visible.
CellValue = Range("AY82")
    Select Case CellValue
        Case "Y"
            Range("AP83").NumberFormat = "text"
'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.
        Case "N", ""
            Range("AP83").NumberFormat = ";;;"
    End Select
End Sub
Private Sub Vaccinations_and_SpecialTreatment_Conditions()
Dim CellValue As Variant
'O [1 of 4]: INFLUENZA--> If resident received the influenza vaccination in-facility [G96 = Y], date [C97] is visible.
CellValue = Range("G96")
    Select Case CellValue
        Case "Y"
            Range("C97").NumberFormat = "text"
'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.
        Case "N", ""
            Range("C97").NumberFormat = ";;;"
    End Select
'O [3 of 4]: SPECIAL TREATMENTS--> If resident did not receive any special treatments [Y86 = checked], then options
'[Y87:Y99] are hidden.
CellValue = Range("Y86")
    Select Case CellValue
        Case "P"
            Range("Y87:Y99").NumberFormat = ";;;"
'O [4 of 4]: SPECIAL TREATMENTS--> If resident received any special treatments or the cell [Y86] is blank, then options
'[Y87:Y99] are visible.
        Case ""
            Range("Y87:Y99").NumberFormat = "text"
    End Select
End Sub
Private Sub SpecailTreatment_LogicCheck()
Dim CallValue As Variant

'O: Logic Check:If any special treatments while a resident are blank then their corresponding cells for on admission are
'blank.
CellValue = Range("AO87")
    Select Case CellValue
        Case ""
            Range("AG87").Value = ""
    End Select
CellValue = Range("AO88")
    Select Case CellValue
        Case ""
            Range("AG88").Value = ""
    End Select
CellValue = Range("AO89")
    Select Case CellValue
        Case ""
            Range("AG89").Value = ""
    End Select
CellValue = Range("AO90")
    Select Case CellValue
        Case ""
            Range("AG90").Value = ""
    End Select
CellValue = Range("AO91")
    Select Case CellValue
        Case ""
            Range("AG91").Value = ""
    End Select
CellValue = Range("AO92")
    Select Case CellValue
        Case ""
            Range("AG92").Value = ""
    End Select
CellValue = Range("AO93")
    Select Case CellValue
        Case ""
            Range("AG93").Value = ""
    End Select
CellValue = Range("AO94")
    Select Case CellValue
        Case ""
            Range("AG94").Value = ""
    End Select
CellValue = Range("AO95")
    Select Case CellValue
        Case ""
            Range("AG95").Value = ""
    End Select
CellValue = Range("AO96")
    Select Case CellValue
        Case ""
            Range("AG96").Value = ""
    End Select
CellValue = Range("AO99")
    Select Case CellValue
        Case ""
            Range("AG99").Value = ""
    End Select
End Sub



I currently have this saved as a macro-enabled template. The original ideas was to use this as a form. I would have one master form that is blank and could just copy the sheet each time I needed to complete a new form. Theoretically I would like to be able to just have this saved as a macro-enabled workbook, but I was worried about messing with the VBA coding for tweaks and messing the whole thing up, so I have it saved as a template as kind of a can't-mess-this-one-up back-up.

The problem I am having, is that once I have more than one copy of this sheet, Excel starts getting extremely slow. It seems to be worse the more copies there are. When there is just one sheet, everything works beautifully. I have been completing the template form and then moving it to another book where all my completed forms are. This new book is still slow, but since the forms are already completed for the most part, and
may only need a little editing, it is not as bad as trying to complete the form when Excel is super slow.

Any suggestions?
 
Hello @Aphten. I think that it is unlikely that anyone will be able to help you without seeing the files themselves (at least examples). There is a lot of code, that's true. But without example files.
Note: my post does not mean that I undertake to help you so that later there will be no claims against me (there have been cases already). Good luck.
 
Upvote 0

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