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.
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?
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 SubI 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?
