Best practice when checking multiple addresses for a Worksheet_Change() event?

Question

I'm doing some code revision and I'm looking at this portion of my Worksheet_Change() event:

If Target.Address = "$A$4" Or _
       Target.Address = "$A$7" Or _
       Target.Address = "$A$10" Or _
       Target.Address = "$B$21" Or _
       Target.Address = "$B$22" Or _
       Target.Address = "$B$23" Or _
       Target.Address = "$B$24" Or _
       Target.Address = "$B$25" Or _
       Target.Address = "$B$26" Or _
       Target.Address = "$B$33" Or _
       Target.Address = "$B$35" Then

I'm considering using Union() and Intersect() to determine if my Target.Address is within the range - would this be a better solution than what I have above? I don't like the idea of losing readability, but I also want to keep things clean and concise.

EDIT: Here's my entire Worksheet_Change() event - have at it! Please disregard the clinical verbiage. This is all for 1 worksheet where I have several cells that can be changed. These cells reference categories, start times and end times. Based on category selection or the start date and end date, data validation is changed on another worksheet.

A good portion of this code manipulates a single chart that displays all of the employee data side by side. There's also an average line, a standard deviation line, and a special criteria line that may or may not be displayed on the chart. Additionally, certain locations can be filtered out from the chart based on the values in cells B12 through B26 (Show or Hide).

The individual bars on the graph are colored based on which location an employee belongs to. Also, n values are added as additional data points on the graph.

I'll also add that there are additional subroutines that are called in here, but they serve another purpose (they're used to create assessment reports). One also populates a listbox with employee initials that are out of range, to which a user can click them and be brought to a chart breaking down their numbers by week/month/year.

Here's what the worksheet looks like, with some private information blocked out:

Option Explicit
Option Compare Text
Dim catcol As Long, topnum As Long, botnum As Long, individual As Long, i As Long, j As Long, seriescount As Long
Dim title As String, averageformula As String, nvalueformula As String, nvaluetext As String, sdformula As String
Dim updatecharts As Boolean, yaxisnumerical As Boolean
Dim overallstats As Worksheet, datapulloverall As Worksheet, indivstats As Worksheet
Dim cht As Chart
Dim chtObj As ChartObject
Private Sub Worksheet_Change(ByVal Target As Range)

    Set overallstats = ThisWorkbook.Worksheets("Overall Statistics")
    Set datapulloverall = ThisWorkbook.Worksheets("Data Pull - Overall")
    Set chtObj = overallstats.ChartObjects("Chart 1")
    Set cht = chtObj.Chart

    'Category change
    If Target.Address = "$A$4" Or _
       Target.Address = "$A$7" Or _
       Target.Address = "$A$10" Or _
       Target.Address = "$B$21" Or _
       Target.Address = "$B$22" Or _
       Target.Address = "$B$23" Or _
       Target.Address = "$B$24" Or _
       Target.Address = "$B$25" Or _
       Target.Address = "$B$26" Or _
       Target.Address = "$B$33" Or _
       Target.Address = "$B$35" Then

        'Check previous value hidden in columns near the change cell - if it's the same value, don't run the script.
        If Target.Address = "$A$4" And Target.Value = overallstats.Cells(5, 1).Value Then Exit Sub
        If Target.Address = "$A$7" And Target.Value = overallstats.Cells(8, 1).Value Then Exit Sub
        If Target.Address = "$A$10" And Target.Value = overallstats.Cells(11, 1).Value Then Exit Sub
        If Target.Address = "$B$33" And Target.Value = overallstats.Cells(34, 2).Value Then Exit Sub
        If Target.Address = "$B$35" And Target.Value = overallstats.Cells(36, 2).Value Then Exit Sub

        Application.EnableEvents = False

        'On Error GoTo ErroredOut

        Application.ScreenUpdating = False

        updatecharts = True

        overallstats.Unprotect "pw"

        Select Case overallstats.Cells(4, 1).Value
            Case "ICSI Fert Rate"
                individual = 3
                title = "ICSI Scientist"
                nvaluetext = "Total # ICSI'd"
            Case "IVF FR/Sperm Processor"
                individual = 4
                title = "Sperm Processor"
                nvaluetext = "Total # Mature Oocytes"
            Case "Necrotic Rate/ICSI Embryologist"
                individual = 3
                title = "ICSI Scientist"
                nvaluetext = "Total # Mature Oocytes"
            Case "Necrotic Rate/Fert Assessor"
                individual = 5
                title = "Fert Assessor"
                nvaluetext = "Total # Mature Oocytes"
            Case "IVF FR/Fert Assessor"
                individual = 5
                title = "Fert Assessor"
                nvaluetext = "Total # Mature Oocytes"
            Case "Ectopic Rate/Transfer Scientist"
                individual = 8
                title = "Transfer Scientist"
                nvaluetext = "Total # Embryo Transfers"
            Case "PR/UT Embryologist"
                individual = 8
                title = "UT Embryologist"
                nvaluetext = "Total # Embryo Transfers"
            Case "PR/Thaw Embryologist"
                individual = 10
                title = "Thaw Embryologist"
                nvaluetext = "Total # Embryo Transfers"
            Case "PR/Freeze Embryologist"
                individual = 9
                title = "Freeze Embryologist"
                nvaluetext = "Total # Embryo Transfers"
            Case "PR/Biopsy Embryologist"
                individual = 13
                title = "Biopsy Embryologist"
                nvaluetext = "Total # Embryo Transfers"
            Case "Average # Eggs/Scientist"
                individual = 7
                title = "Scientist"
                yaxisnumerical = True
                nvaluetext = "Total # Retrievals"
            Case "Survival rate by thaw"
                individual = 10
                title = "Thaw Scientist"
                nvaluetext = "Total # Embryos Thawed"
            Case "Survival rate by freeze (cryo date)"
                individual = 9
                title = "Cryo Scientist"
                nvaluetext = "Total # Embryos Thawed"
            Case "Survival rate by freeze (thaw date)"
                individual = 9
                title = "Cryo Scientist"
                nvaluetext = "Total # Embryos Thawed"
            Case "Not recovered rate by thaw"
                individual = 10
                title = "Thaw Scientist"
                nvaluetext = "Total # Embryos Thawed"
            Case "Not recovered rate by freeze"
                individual = 9
                title = "Cryo Scientist"
                nvaluetext = "Total # Embryos Thawed"
            Case "No result biopsy rate"
                individual = 11
                title = "No Result BX Tech"
                nvaluetext = "Total # Embryos Biopsied"
            Case "Damaged during biopsy rate"
                individual = 12
                title = "Lysed Embryo Tech"
                nvaluetext = "Total # Embryos Biopsied"
            Case "Usable Blast/ICSI Embryologist"
                individual = 3
                title = "ICSI Embryologist"
                nvaluetext = "Total # ICSI Ferts"
        End Select

        overallstats.Cells(16, 1).Value = nvaluetext
        overallstats.Protect "pw"

    End If

    If updatecharts = True Then

        'Repopulate the individuals lists on x-axis based on date
        Call PopulateDataPullOverallValidation

        overallstats.Unprotect "pw"

        catcol = datapulloverall.Rows(1).Find(What:=overallstats.Cells(4, 1).Value).Column
        averageformula = Replace(datapulloverall.Cells(2, catcol).Formula, "$" & ColumnLetter(individual) & "2", """*""")
        sdformula = Replace(Left(Split(datapulloverall.Cells(2, catcol).Formula, "/")(1), Len(Split(datapulloverall.Cells(2, catcol).Formula, "/")(1)) - 3), "$" & ColumnLetter(individual) & "2", """*""")

        'Update average column on Data Pull - Overall  - NOT DYNAMIC row range
        datapulloverall.Range("AG2:AG50").Formula = averageformula

        'Change to whole numbers for average eggs retrieved, otherwise leave as percentage
        If overallstats.Cells(4, 1).Value = "Average # Eggs/Scientist" Then
            datapulloverall.Range("AG2:AG50").NumberFormat = "0.00"
            datapulloverall.Range("AJ2:AJ50").NumberFormat = "0.00"
        Else
            datapulloverall.Range("AG2:AG50").NumberFormat = "0.00%"
            datapulloverall.Range("AJ2:AJ50").NumberFormat = "0.00%"
        End If

        'Update the adjusted average column on Data Pull - Overall - NOT DYNAMIC row range
        If overallstats.Cells(4, 1).Value = "ICSI Fert Rate" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.05)
            overallstats.Range("A33").Value = "Calc 5% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "PR/UT Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "Necrotic Rate/ICSI Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value + (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% above mean"
        ElseIf overallstats.Cells(4, 1).Value = "Survival rate by thaw" Or _
               overallstats.Cells(4, 1).Value = "Survival rate by freeze (thaw date)" Or _
               overallstats.Cells(4, 1).Value = "Survival rate by freeze (cryo date)" Then
            datapulloverall.Range("AJ2:AJ50").Value = 0.97
            overallstats.Range("A33").Value = "97% static"
        ElseIf overallstats.Cells(4, 1).Value = "No result biopsy rate" Then
            datapulloverall.Range("AJ2:AJ50").Value = 0.04
            overallstats.Range("A33").Value = "4% static"
        ElseIf overallstats.Cells(4, 1).Value = "IVF FR/Sperm Processor" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "Necrotic Rate/Fert Assessor" Then
            datapulloverall.Range("AJ2:AJ50").Value = 0.04
            overallstats.Range("A33").Value = "4% static"
        ElseIf overallstats.Cells(4, 1).Value = "IVF FR/Fert Assessor" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "Ectopic Rate/Transfer Scientist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value + (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% above mean"
        ElseIf overallstats.Cells(4, 1).Value = "PR/Thaw Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "PR/Freeze Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "PR/Biopsy Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        ElseIf overallstats.Cells(4, 1).Value = "Not recovered rate by thaw" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value * 2
            overallstats.Range("A33").Value = "Above 2 x mean"
        ElseIf overallstats.Cells(4, 1).Value = "Not recovered rate by freeze" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value * 2
            overallstats.Range("A33").Value = "Above 2 x mean"
        ElseIf overallstats.Cells(4, 1).Value = "Not recovered rate by freeze" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value * 2
            overallstats.Range("A33").Value = "Above 2 x mean"
        ElseIf overallstats.Cells(4, 1).Value = "Damaged during biopsy rate" Then
            datapulloverall.Range("AJ2:AJ50").Value = 0.005
            overallstats.Range("A33").Value = "0.5% static"
        ElseIf overallstats.Cells(4, 1).Value = "Usable Blast/ICSI Embryologist" Then
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - (datapulloverall.Range("AG2").Value * 0.1)
            overallstats.Range("A33").Value = "Calc 10% below mean"
        Else
            datapulloverall.Range("AJ2:AJ50").Value = datapulloverall.Range("AG2").Value - 0.1
            overallstats.Range("A33").Value = "-0.1"
        End If

        'Update standard deviation column on Data Pull - Overall - NOT DYNAMIC row range
        datapulloverall.Range("AI2:AI50").Formula = "=IFERROR(MAX(AG2" & overallstats.Cells(35, 1).Value & "*SQRT(AG2*(1-AG2)/" & sdformula & ")),0)"

        For i = 2 To 50
            nvalueformula = Left(Split(datapulloverall.Cells(i, catcol).Formula, "/")(1), Len(Split(datapulloverall.Cells(i, catcol).Formula, "/")(1)) - 3)
            datapulloverall.Range("AH" & i).Formula = "=""n: "" & " & nvalueformula
        Next i

        topnum = 2
        botnum = datapulloverall.Cells(datapulloverall.Rows.Count, individual).End(xlUp).Row

        With cht

            On Error Resume Next
            .FullSeriesCollection(4).Delete
            .FullSeriesCollection(3).Delete
            .FullSeriesCollection(2).Delete
            .FullSeriesCollection(1).Delete
            On Error GoTo 0

            'Add the main series
            .SeriesCollection.NewSeries
            .FullSeriesCollection(1).Name = "=""" & overallstats.Cells(4, 1).Value & """"
            .FullSeriesCollection(1).Values = "='Data Pull - Overall'!$" & ColumnLetter(catcol) & "$" & topnum & ":$" & ColumnLetter(catcol) & "$" & botnum
            .FullSeriesCollection(1).XValues = "='Data Pull - Overall'!$" & ColumnLetter(individual) & "$" & topnum & ":$" & ColumnLetter(individual) & "$" & botnum
            .Axes(xlCategory, xlPrimary).AxisTitle.Text = title
            .SeriesCollection(1).HasDataLabels = True

            'This line causing errors for whatever reason, 7-25-19
            On Error Resume Next
            .SeriesCollection(1).DataLabels.Format.TextFrame2.TextRange.InsertChartField msoChartFieldRange, "='Data Pull - Overall'!$AH$2:$AH$" & botnum, 0
            On Error GoTo 0

            .SeriesCollection(1).DataLabels.ShowRange = True
            .SeriesCollection(1).DataLabels.Separator = "" & Chr(13) & ""

            'Add an average line
            .SeriesCollection.NewSeries
            .FullSeriesCollection(2).Name = "=""Average"""
            .FullSeriesCollection(2).Values = "='Data Pull - Overall'!$AG$2:$AG$" & datapulloverall.Cells(datapulloverall.Rows.Count, individual).End(xlUp).Row
            .FullSeriesCollection(2).ChartType = xlLine
            .FullSeriesCollection(2).Format.Line.ForeColor.RGB = RGB(255, 0, 0)

            On Error Resume Next
            .FullSeriesCollection(2).DataLabels.ShowValue = False
            On Error GoTo 0

            .FullSeriesCollection(2).Format.Line.Weight = 2

            seriescount = 2

            If overallstats.Cells(35, 2).Value = "Show" Then
                'Add a SD line
                seriescount = seriescount + 1
                .SeriesCollection.NewSeries
                .FullSeriesCollection(seriescount).Name = "=""Standard Deviation"""
                .FullSeriesCollection(seriescount).Values = "='Data Pull - Overall'!$AI$2:$AI$" & datapulloverall.Cells(datapulloverall.Rows.Count, individual).End(xlUp).Row
                .FullSeriesCollection(seriescount).ChartType = xlLine
                .FullSeriesCollection(seriescount).Format.Line.ForeColor.RGB = RGB(128, 0, 128)
            End If

            On Error Resume Next
            .FullSeriesCollection(seriescount).DataLabels.ShowValue = False
            On Error GoTo 0

            .FullSeriesCollection(seriescount).Format.Line.Weight = 2

            If overallstats.Cells(33, 2).Value = "Show" Then
                'Add an average minus 10 percent line
                seriescount = seriescount + 1
                .SeriesCollection.NewSeries
                .FullSeriesCollection(seriescount).Name = "=""Average Minus 10"""
                .FullSeriesCollection(seriescount).Values = "='Data Pull - Overall'!$AJ$2:$AJ$" & datapulloverall.Cells(datapulloverall.Rows.Count, individual).End(xlUp).Row
                .FullSeriesCollection(seriescount).ChartType = xlLine
                .FullSeriesCollection(seriescount).Format.Line.ForeColor.RGB = RGB(175, 0, 175)
            End If

            On Error Resume Next
            .FullSeriesCollection(seriescount).DataLabels.ShowValue = False
            On Error GoTo 0

            .FullSeriesCollection(seriescount).Format.Line.Weight = 2

            'The following adjusts the minimum and maximum values on the y-axis so we can better view the data
            If yaxisnumerical = False Then

                .Axes(xlValue).MinimumScale = 0
                .Axes(xlValue).MaximumScale = 1

                If overallstats.Cells(4, 1).Value = "Damaged during biopsy rate" Or _
                   overallstats.Cells(4, 1).Value = "Necrotic Rate/Fert Assessor" Then

                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 0.05

                ElseIf InStr(overallstats.Cells(4, 1).Value, "Not recovered rate") Then

                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 0.1

                ElseIf overallstats.Cells(4, 1).Value = "No result biopsy rate" Or _
                       overallstats.Cells(4, 1).Value = "Necrotic Rate/ICSI Embryologist" Then

                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 0.15

                ElseIf InStr(overallstats.Cells(4, 1).Value, "Survival rate") Then

                    .Axes(xlValue).MinimumScale = 0.9
                    .Axes(xlValue).MaximumScale = 1

                ElseIf overallstats.Cells(4, 1).Value = "Ectopic Rate/Transfer Scientist" Then

                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 0.13

                Else

                    .Axes(xlValue).MinimumScale = 0
                    .Axes(xlValue).MaximumScale = 1

                End If

                .Axes(xlValue).TickLabels.NumberFormat = "0.0%"
                .Axes(xlValue, xlPrimary).AxisTitle.Text = "Rate"
            Else
                .Axes(xlValue).MinimumScale = 0
                .Axes(xlValue).MaximumScale = 35
                .Axes(xlValue).TickLabels.NumberFormat = "0"
                .Axes(xlValue, xlPrimary).AxisTitle.Text = "Average # Eggs Retrieved"
            End If

            'Color code bars based on satellite location
            Dim xvaluesarr As Variant
            Dim xval As Variant
            Dim j As Long

            xvaluesarr = .SeriesCollection(1).XValues
            j = 1

            For Each xval In xvaluesarr

                .FullSeriesCollection(1).Points(j).Format.Fill.Visible = msoTrue

                'Location 1
                If xval = "AEF" Or xval = "KMJ" Or xval = "RGR" Then
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(0, 176, 80)
                'Location 2
                ElseIf xval = "MLF" Or xval = "BAS" Then 'Removed CP - not on the initials list from Marianne
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(192, 0, 0)
                'Location 3
                ElseIf xval = "CJT" Or xval = "RXS" Then 'Removed KH - not on the initials list from Marianne
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(225, 153, 0)
                'Location 4
                ElseIf xval = "TLL" Or xval = "LMH" Then
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(112, 48, 160)
                'Location 5
                ElseIf xval = "MJA" Or xval = "ADB" Then 'Removed AW - not on initials list from Marianne
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(45, 239, 239)
                'Anyone else
                Else
                    .FullSeriesCollection(1).Points(j).Format.Fill.ForeColor.RGB = RGB(11, 0, 228)
                End If

                    .FullSeriesCollection(1).Points(j).Format.Fill.Solid

                j = j + 1

            Next xval

            Dim mystr As String

            'Get N Value
            mystr = "=" & Replace(Left(Split(datapulloverall.Cells(2, catcol).Formula, "/")(1), Len(Split(datapulloverall.Cells(2, catcol).Formula, "/")(1)) - 3), "$" & ColumnLetter(individual) & "2", """*""")
            mystr = Replace(Replace(mystr, "$A$2", "'Data Pull - Overall'!A2"), "$B$2", "'Data Pull - Overall'!B2")
            overallstats.Cells(17, 1).Value = mystr

            updatecharts = False
            yaxisnumerical = False

            If overallstats.Cells(38, 22).Value <> "Presentation Mode" Then
                Call PopulateBottomTable
            End If

            Call PopulateOutofRangeInitials

        End With

    If Target.Address = "$A$4" Then overallstats.Cells(5, 1).Value = Target.Value
    If Target.Address = "$A$7" Then overallstats.Cells(8, 1).Value = Target.Value
    If Target.Address = "$A$10" Then overallstats.Cells(11, 1).Value = Target.Value
    If Target.Address = "$B$33" Then overallstats.Cells(34, 2).Value = Target.Value
    If Target.Address = "$B$35" Then overallstats.Cells(36, 2).Value = Target.Value

     'Update the cell that says what the chart is displaying
    overallstats.Cells(8, 22).Value = Application.WorksheetFunction.VLookup(overallstats.Cells(4, 1).Value, ThisWorkbook.Worksheets("Data Validation").Range("N:Q"), 4, False)

    overallstats.Protect "pw"

    End If

    If overallstats.Cells(38, 22).Value = "Presentation Mode" Then
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If

    Exit Sub

ErroredOut:

    overallstats.Protect "pw"

    Debug.Print Err.Number
    Debug.Print Err.Description

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub
Function ColumnLetter(colnum As Long) As String

    ColumnLetter = Split(Cells(1, colnum).Address, "$")(1)

End Function

PeterT · Accepted Answer · 2020-02-20 22:50:06Z

I'll answer your question on the best practice for checking multiple cells in a Worksheet_Change event, but I have some other comments that will hopefully help as well.

The "best practice" I have used in Worksheet_Change events is to use the Intersect function. If you just make this a habit, then your code will be consistent (even if you're only checking a single cell).

Because you have multiple cells on the worksheet to monitor, you want to compare the Target to a range. If the range is contiguous, then the check can be pretty straightforward:

Private Sub Worksheet_Change(ByVal target As Range)
    If Not Intersect(target, Range("A1:D25") Is Nothing Then
        '--- respond to what changed here
    End If
End Sub

Your situation is a bit trickier because you have multiple, non-contiguous cells to check. So for this I would create a function (in a separate module) that creates a single range (Union) for all the cells you need to monitor. That function looks like this:

Public Function DefinedWatchArea() As Range
    With Sheet1
        Set DefinedWatchArea = Union(.Range("$A$4"), _
                                     .Range("$A$7"), _
                                     .Range("$A$10"), _
                                     .Range("$B$21"), _
                                     .Range("$B$22"), _
                                     .Range("$B$23"), _
                                     .Range("$B$24"), _
                                     .Range("$B$25"), _
                                     .Range("$B$25"), _
                                     .Range("$B$33"), _
                                     .Range("$B$35"))
    End With
End Function

Note that the function must specify the worksheet, whereas the Worksheet_Change sub can rely on the currently active sheet to be the default (i.e. you don't need the dot . in front of Range in the Worksheet_Change sub). A function like this also makes it easier if you ever need to add or change the different cells to check.

So now the change event sub for you would be:

Private Sub Worksheet_Change(ByVal target As Range)
    If Not Intersect(target, DefinedWatchArea()) Is Nothing Then
        If Not ValuesHaveChanged(target) Then
            UpdateStatsAndCharts
        End If
    End If
End Sub

My next point is a guide for writing Excel event handlers such as this one. If the actions you need to take are anything more than a couple lines, it's best to create separate subs or functions in a separate code module. There are a couple reasons for this: the code is more easily re-used if it's in a code module, and it greatly simplifies the logic in the handler itself. Your Worksheet_Change sub is very long, and should be separated into multiple methods anyway.

So let's look at my ValuesHaveChanged function. You need to check the value in several cells. Since it seemed that you may need to add more cells to check in the future, I've created a "value map" (in a Dictionary) that links the changed target cell address with a cell on your overallStatus worksheet. This map is created like this:

Public Function DefinedValueMap() As Dictionary
    Dim map As Dictionary
    Set map = New Dictionary
    With map
        .Add "$A$4", Array(5, 1)
        .Add "$A$7", Array(8, 1)
        .Add "$A$10", Array(11, 1)
        .Add "$B$22", Array(34, 2)
        .Add "$B$35", Array(36, 2)
    End With
    Set DefinedValueMap = map
End Function

Of course, this makes it easier to change your map without changing the other logic since the map assignments are isolated in this single function.

Now back in the Worksheet_Change sub when you call ValuesHaveChanged, it calls this function:

Public Function ValuesHaveChanged(ByRef target As Range) As Boolean
    Dim overallStats As Worksheet
    Set overallStats = ThisWorkbook.Worksheets("Overall Statistics")

    Dim valueMap As Dictionary
    Set valueMap = DefinedValueMap()

    If valueMap.Exists(target.Address) Then
        Dim rowcol As Variant
        rowcol = valueMap(target.Address)
        If target.Value <> overallStats.Cells(rowcol(0), rowcol(1)).Value Then
            ValuesHaveChanged = False
        End If
    End If
End Function

Creating a map in this fashion gets you out of a very long and confusing If statement or Select Case statement and keeps the logic cleaner and shorter.

The same logic applies to the rest of your original code. Separate it out into logic sections that make it easier to follow. In my example of UpdateStatsAndCharts, I'm also creating another map for the statistics data and using that to assign some variables.

I'm leaving the rest of the code for you to refactor along the same lines.

 Public Function DefinedStatMap() As Dictionary
    Dim map As Dictionary
    Set map = New Dictionary
    With map
        '--- array item is (individual, title, nvaluetext)
        .Add "ICSI Fert Rate", Array(3, "ICSI Scientist", "Total # ICSI'd")
        .Add "IVF FR/Sperm Processor", Array(4, "Sperm Processor", "Total # Mature Oocytes")
        .Add "Necrotic Rate/ICSI Embryologist", Array(3, "ICSI Scientist", "Total # Mature Oocytes")
        .Add "Necrotic Rate/Fert Assessor", Array(5, "Fert Assessor", "Total # Mature Oocytes")
        .Add "IVF FR/Fert Assessor", Array(5, "Fert Assessor", "Total # Mature Oocytes")
        ' add all the others ...
    End With
    Set DefinedStatMap = map
End Function

Public Sub UpdateStatsAndCharts()
    AppUpdates flagEnables:=False

    Dim statMap As Dictionary
    Set statMap = DefinedStatMap()

    Dim overallStats As Worksheet
    Set overallStats = ThisWorkbook.Worksheets("Overall Statistics")

    Dim individual As Long
    Dim title As String
    Dim nvaluetext As String
    With overallStats
        If statMap.Exists(.Cells(4, 1).Value) Then
            Dim itemData As Variant
            itemData = statMap(.Cells(4, 1).Value)
            individual = itemData(0)
            title = itemData(1)
            nvaluetext = itemData(2)
        Else
            '--- what do you do if the value is not defined??
            MsgBox "some kind of error!"
            Exit Sub
        End If

        'Repopulate the individuals lists on x-axis based on date
        Call PopulateDataPullOverallValidation

        '--- continue with the rest of your business logic...
    End With

    AppUpdates flagEnables:=True
End Sub

Public Sub AppUpdates(ByVal flagEnables As Boolean)
    With Application
        .EnableEvents = flagEnables
        .ScreenUpdating = flagEnables
    End With

    Dim overallStats As Worksheet
    Set overallStats = ThisWorkbook.Worksheets("Overall Statistics")
    If flagEnables Then
        overallStats.Protect "bivf"
    Else
        overallStats.Unprotect "bivf"
    End If
End Sub

Stack Exchange Network

Best practice when checking multiple addresses for a Worksheet_Change() event?

1 Answer 1

Your Answer

Not the answer you're looking for? Browse other questions tagged
vba
excel
or ask your own question.

Hot Network Questions

Best practice when checking multiple addresses for a Worksheet_Change() event?

1 Answer 1

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged vbaexcel or ask your own question.

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
vba
excel
or ask your own question.