I have a functioning code to calculate the value of a cell automatically upon entering a value in another cell - Worksheet_Change() The problem is that the sheet I want to use it in is automatically generated and I do not seem to figure out how to combine these two.
This is the code for creating the new ws:
Dim ws As Worksheet
Dim shtName As String
shtName = nachname & "_" & barcode
Set ws = ThisWorkbook.Worksheets.Add(After:=Sheets("Analysen"))
ws.Name = nachname & "_" & barcode
Application.EnableEvents = True
This is the code for calculations:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Age As Long
Dim sex_male As Boolean
Dim SKr As Double
Dim eGFR As Double
Dim dob As Date
Dim k As Double
Dim alpha As Double
' Read the date of birth from cell C6
dob = Range("C6").Value
' Check if the dob is a valid date
If IsDate(dob) Then
' Calculate the age in years
Age = DateDiff("yyyy", dob, Date)
If Date < DateSerial(Year(Date), Month(dob), Day(dob)) Then
Age = Age - 1
End If
Else
' Show an error message box
MsgBox "Bitte gib ein valides Geburtsdatum ein"
Exit Sub
End If
' Read the sex from cell C4
sex_male = False
If Right(Range("C4").Value, 1) = "M" Then
sex_male = True
End If
If Not Intersect(Target, Range("D25")) Is Nothing Then
If IsNumeric(Target.Value) Then
SKr = Target.Value
'set k, alpha, and GFR values based on sex
If sex_male Then
k = 0.9
alpha = -0.302
Else
k = 0.7
alpha = -0.241
End If
'calculate GFR using the CKD-EPI formula
eGFR = 141 * (Min(SKr / k, 1)) ^ alpha * (Max(SKr / k, 1)) ^ (-1.209) * (0.993 ^ Age)
'multiply GFR by 1.018 if female
If Not sex_male Then
eGFR = eGFR * 1.018
End If
Debug.Print (eGFR)
Cells(Target.Row + 1, Target.Column).Value = eGFR
Cells(Target.Row + 1, Target.Column).NumberFormat = "0.0"
Else
MsgBox ("Bitte gib eine Zahl im Kreatininfeld ein")
End If
End If
End Sub
Private Function Max(num1 As Double, num2 As Double) As Double
If num1 > num2 Then
Max = num1
Else
Max = num2
End If
End Function
Private Function Min(num1 As Double, num2 As Double) As Double
If num1 < num2 Then
Min = num1
Else
Min = num2
End If
End Function