'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 |
