Excel VBA how to .clearcontents on fluid range and possibly on worksheet_calculate?

Question

Okay, so my problem is the following. What I'm basically doing is that I have a patientfile, on sheet1 , I have some basic information of each patient. Column A of that page is manually edited. It is our "main page". We have 25 rooms, and usually all rooms are filled. So when we get a new patient, it will be entered on the line of where an old patient was.

On sheet2 I have extended information on each patient. The patientname is taken from sheet1 and after that comes extended information of the patient. Sheet2 can be sorted in different ways, for example, last name of patient, room number etc. So the patients won't always be in the same order as they are on sheet 1.

To explain what I want is the following: Whenever a patient gets discharged, I want the extended information of that patient cleared in sheet2, as it needs to be "reset" for the information of the new patient.

Below are images of what I mean:

Before new patient comes in Sheet1 Sheet2

New patient comes in Patient6 was replaced with Patient12 on sheet1, thus on sheet2 the extra information for Patient6 (which now stands with Patient12) was removed. Sheet1 Sheet2 Like this, extended information for patient12 can be added again, without risking that extend information of the previous patient sticks around and suddenly belongs to patient12

Like these images, the same goes for all other cells in sheet1.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oSheet1 As Worksheet
    Dim oSheet2 As Worksheet

    Dim oLookFor As Range
    Dim oFound As Range
If Not Intersect(Target, Columns(1)) Is Nothing Then


    Set oSheet1 = ThisWorkbook.Worksheets("Blad1")
    Set oSheet2 = ThisWorkbook.Worksheets("Blad2")

    Set oLookFor = oSheet1.Range("A1")

    Set oFound = oSheet2.Columns(1).Find(what:=oLookFor.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)

    If Not oFound Is Nothing Then
        oFound.Range("B" & Target.Row & ":D" & Target.Row).ClearContents
    Else
        MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name
    End If

End If
End Sub

The above code, whether it be with .Columns(1) or .Range(A:A) will only work for 1 cell, because the oLookFor is set to just look at sheet1 A1.

That's where I miss the part which I can't figure out.

If the patient that gets switched is in cell A1, then sure, the code does what it has to do. It looks at the patients name in A1, searches this name and removes the extra information in sheet2. But what I now need to add, that if a patient's name in cell A3 changes, search the new name in sheet2 and remove the extra information. Same goes for the other cells.

ALSO: it is never the case that ALL patients change at once, it goes one by one.

I'm guessing for it to work, I would have to check which values in cells A1 to A5 actually change. Then only for the cell that changes lookup the value in sheet2 and clear the corresponding row. But I really have no idea how to set this up...

Update Been fooling around myself some more. By combining the code of @Dschuli and some standard example on how to use a For Each cell statement I've managed to make it work :) Below is the code which does what I want:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oSearchArea As Range
    Dim oSheet2 As Worksheet

    Dim oLookUpArea As Range
    Dim oFound As Range

    Set oSearchArea = Intersect(Target, Target.Parent.Range("A1:A5"))
    Set oSheet2 = ThisWorkbook.Worksheets("Blad2")
    Set oLookUpArea = oSheet2.Columns(1)

    If Not oSearchArea Is Nothing Then
        Application.EnableEvents = False 'pervent triggering another change event

        Dim Cel As Range
        For Each Cel In oSearchArea.Cells
            Set oFound = oLookUpArea.Find(what:=Cel.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)

            If Not oFound Is Nothing Then
                oFound.Columns("B:D").ClearContents
            Else
                MsgBox Cel.Value & " not found on sheet " & oSheet2.Name
            End If
        Next Cel

        Application.EnableEvents = True 'don't forget to re-enable events in the end
    End If
End Sub

Answer 1

but I have 25 values it has to look at.

You have got most of what you wanted. As for the last part, set your range accordingly as shown below and then use that as I hinted in the comment above.

Is this what you are trying?

Option Explicit

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

    '~~> This is the range which you want to capture
    '~~> amend it as per your requirements
    Set rng = Range("A1,D1,E4,G8,H14")

    If Not Intersect(Target, rng) Is Nothing Then
        '
        '~~> Do what you want
        '
        MsgBox Target.Address
    End If
End Sub

On a side note, since you are working with Worksheet_Change , I would recommend you give a glance at This Thread as well.

Answer 2

A shot at your problem - assuming you always look/search in column 1 ("A") and you're target area does not contain any blank cells.

Version 3 now as stated in the comment below.

Private Sub Worksheet_Change(ByVal Target As Range)         'Version 3
    Dim oSheet1 As Worksheet
    Dim oSheet2 As Worksheet

    Dim oSensitiveArea As Range
    Dim oLookUpArea As Range
    Dim relevantChanges As Range
    Dim oFound As Range
    Dim oLookFor As Range

    Dim columnsToClear As String

     Set oSheet1 = ThisWorkbook.Worksheets("Blad1")
     Set oSheet2 = ThisWorkbook.Worksheets("Blad2")

    'Define the ranges that the event procedure should react on and where to look for
    'In this case its the first column of the two sheets
    Set oSensitiveArea = oSheet1.Columns(1)
    Set oLookUpArea = oSheet2.Columns(1)
    columnsToClear = "B:D"

    Set relevantChanges = Intersect(Target, oSensitiveArea)

    If Not relevantChanges Is Nothing Then

        For Each oLookFor In relevantChanges.Cells

            If Len(oLookFor.Value) = 0 Then Exit For               'Stop the loop if a blank cell (length = 0) is encountered

            Set oFound = oLookUpArea.Find(what:=oLookFor.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)

            If Not oFound Is Nothing Then
                oFound.EntireRow.Columns(columnsToClear).ClearContents
            Else
                MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name
            End If

        Next oLookFor

    End If

End Sub