VBA In a Table Range Cell A4 <> "" then Cell B4 = 140. Same for next A5 and B5 and so on

[JulianvO]

Greetings

I have a table("BloodPressure") containing the following fields:
Date - Systolic Baseline - Systolic Reading - Diastolic Baseline - Diastolic Reading - Pulse Rate

When a date is entered, the Systolic Baseline must automatically have the value 140 inserted as well as
the Diastolic Baseline must automatically have the value 90 inserted.

If date column is empty, then no values are entered in columns Systolic Baseline and Diastolic Baseline.

My code:

Option Explicit

Dim BPrng As Range
Dim iDate As Variant
Dim BL1 As Variant
Dim BL2 As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Set BPrng = Sheet1.Range("BloodPressure")

If iDate <> "" Then
BL1 = 140 And BL2 = 90
Else: BL1 = "" And BL2 = ""
End If

End Sub

I keep getting a Type Mismatch error.

I can get the code to work if I specify the Range cells individually, but unable to create a dynamic function.

Can anyone kindly assist me?

Thanking you kindly

 

[PeteWright]

Hi @JulianvO
Could you please share your workbook? I am unable to test the code without proper data.

 

[SunnyAlv]

Like This ?
This code will automatically fill the "Systolic Baseline" column with 140 and "Diastolic Baseline" with 90, with a reference if you enter any value in each column A

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next


If Not Intersect(Range("A:A"), Target) Is Nothing Then
Application.EnableEvents = False
    If Target <> "" Then
        Cells(Target.Row, 2).Value = 140
        Cells(Target.Row, 4).Value = 90
            Else
        Cells(Target.Row, 2).Clear
        Cells(Target.Row, 4).Clear
    End If
End If
Application.EnableEvents = True
End Sub

 

[JulianvO]

Like This ?
This code will automatically fill the "Systolic Baseline" column with 140 and "Diastolic Baseline" with 90, with a reference if you enter any value in each column A

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next


If Not Intersect(Range("A:A"), Target) Is Nothing Then
Application.EnableEvents = False
    If Target <> "" Then
        Cells(Target.Row, 2).Value = 140
        Cells(Target.Row, 4).Value = 90
            Else
        Cells(Target.Row, 2).Clear
        Cells(Target.Row, 4).Clear
    End If
End If
Application.EnableEvents = True
End Sub

View attachment 106192

Greetings

SunnyAlv​

Thank you very much. I have learnt something new.
Greetings

PeteWright​

Please refer to above entry.

Thank you