'Updating matching cells in a row automatically when a cell is updated

I would like to offer pre-set options in certain columns when a validated item is selected. For example, when "Liquid/topical/other" is selected, I would like to automatically place an N/A in specific columns related to number of pills.

I think there may be a more effective way - maybe using "Offset".

"Pill Or Liquid/topical/other" is Column D
"If Liquid/Topical/Other, estimated amount remaining" is column E
"Total number of pills administered daily (multiply # of pills per dose x # of administration times) " is column F
"Number Of Pills Remaining" is column G

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

    If Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]") = "Pill" Then
        Sheets("MedicationCounts").Range("Table1[If Liquid/Topical/Other, estimated amount remaining]") = "N/A"

    ElseIf Sheets("MedicationCounts").Range("Table1[Pill Or Liquid/topical/other]") = "Liquid/topical/other" Then
        Sheets("MedicationCounts").Range("Table1[Total number of pills administered daily (multiply # of pills per dose x # of administration times)]") = "N/A"
        Sheets("MedicationCounts").Range("Table1[Number Of Pills Remaining]") = "N/A"
        Sheets("MedicationCounts").Range("Table1[Number Of Days Remaining]") = "N/A"

    End If

End If
End Sub


Solution 1:[1]

Since you have your data in a ListObject (Table1), we don't need to use Offset and can refer to the ranges using their Headers or column numbers within that table.

I agree with @Cyril that a Select Case statement would also look cleaner and help present the options more clearly.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Save a reference to "Table1"
    Dim Tbl As ListObject
    Set Tbl = Me.ListObjects("Table1")
    
    'Save the column numbers of the important columns in Table1
    'These can be written using header names or column numbers like ListColumns("Name") or ListColumns(#)
    Dim TblCols() As Variant
    TblCols = Array( _
                Tbl.ListColumns("If Liquid/Topical/Other, estimated amount remaining").Range.Column, _
                Tbl.ListColumns("Total number of pills administered daily (multiply # of pills per dose x # of administration times)").Range.Column, _
                Tbl.ListColumns("Number Of Pills Remaining").Range.Column, _
                Tbl.ListColumns("Number Of Days Remaining").Range.Column _
              )
    
    'Save a reference to the watched range
    Dim KeyCells As Range
    Set KeyCells = Tbl.ListColumns("Pill Or Liquid/topical/other").Range
    
    'Check if Target overlaps with KeyCells
    Dim RelevantRange As Range
    Set RelevantRange = Application.Intersect(KeyCells, Target)
    
    'If there are overlapping cells
    If Not RelevantRange Is Nothing Then
        Application.EnableEvents = False

        Dim Cell As Range
        'For each overlapping cell
        For Each Cell In RelevantRange.Cells
            Select Case LCase(Trim(Cell.Value)) 'more flexible string matching with lcase & trim
                Case "pill"
                    Me.Cells(Cell.Row, TblCols(0)).Value = "N/A"
                Case "liquid/topical/other"
                    Me.Cells(Cell.Row, TblCols(1)).Value = "N/A"
                    Me.Cells(Cell.Row, TblCols(2)).Value = "N/A"
                    Me.Cells(Cell.Row, TblCols(3)).Value = "N/A"
            End Select
        Next
        Application.EnableEvents = True
    End If
End Sub

If the above was confusing or if the organization style didn't suit you, another option could be:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    'Save a reference to "Table1"
    Dim Tbl As ListObject
    Set Tbl = Me.ListObjects("Table1")
    
    'Save a reference to the watched range
    Dim KeyCells As Range
    Set KeyCells = Tbl.ListColumns("Pill Or Liquid/topical/other").Range
    
    'Check if Target overlaps with KeyCells
    Dim RelevantRange As Range
    Set RelevantRange = Application.Intersect(KeyCells, Target)
    
    'If there are overlapping cells
    If Not RelevantRange Is Nothing Then
        Application.EnableEvents = False

        Dim Cell As Range
        'For each overlapping cell
        For Each Cell In RelevantRange.Cells
            With Cell.EntireRow
                Select Case LCase(Trim(Cell.Value)) 'more flexible string matching with lcase & trim
                    Case "pill"
                        .Cells(Tbl.ListColumns("If Liquid/Topical/Other, estimated amount remaining").Range.Column).Value = "N/A"
                    Case "liquid/topical/other"
                        .Cells(Tbl.ListColumns("Total number of pills administered daily (multiply # of pills per dose x # of administration times)").Range.Column).Value = "N/A"
                        .Cells(Tbl.ListColumns("Number Of Pills Remaining").Range.Column).Value = "N/A"
                        .Cells(Tbl.ListColumns("Number Of Days Remaining").Range.Column).Value = "N/A"
                End Select
            End With
        Next
        Application.EnableEvents = True
    End If
End Sub

This second one is closer to what you currently have.

I almost forgot about Application.EnableEvents. Whenever you're making worksheet changes during a Worksheet_Change event, it is important to turn off events or you risk ending up in a loop. In this script, it wouldn't loop but it would still waste time.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1