Private Sub Worksheet_Change(ByVal Target As RANGE)
    If Not Intersect(Target, Me.RANGE("C1:C4")) Is Nothing Then
        Application.EnableEvents = False  ' Избежать рекурсии
        Call UpdateLinkedCells(Target)
    
        Application.EnableEvents = True
    End If
End Sub

Sub UpdateLinkedCells(Target As RANGE)
    Dim wsGEN As Worksheet
    Dim wsDB As Worksheet
    Dim lastRowDB As Long
    Dim r As Long
    Dim found As Boolean
    Dim currentC2 As String
    
    Set wsGEN = ThisWorkbook.Sheets("Device_LIST_GENERATION")
    Set wsDB = ThisWorkbook.Sheets("DB_C0")
    lastRowDB = wsDB.Cells(wsDB.Rows.Count, "A").End(xlUp).row
    found = False
    
    ' Сохраняем текущее значение C2 перед изменением
    currentC2 = UCase(Trim(wsGEN.RANGE("C2").Value))
    
    If Target.Address = "$C$2" Then  ' TAG_RELEVANT_EQUIPMENT changed
        Dim selRelevant As String
        selRelevant = UCase(Trim(wsGEN.RANGE("C2").Value))
        For r = 2 To lastRowDB
            If UCase(Trim(wsDB.Cells(r, 3).Value)) = selRelevant Then  ' Column C in DB_C0
                wsGEN.RANGE("C3").Value = wsDB.Cells(r, 5).Value  ' Discipline to C3
                wsGEN.RANGE("C4").Value = wsDB.Cells(r, 2).Value  ' TAG_ITEM_NUMBER_CCMS to C4
                found = True
                Exit For
            End If
        Next r
        
    ElseIf Target.Address = "$C$3" Then  ' Discipline changed
        Dim selDisc As String
        selDisc = UCase(Trim(wsGEN.RANGE("C3").Value))
        
        ' Сначала ищем запись с текущим C2 и новым значением Discipline
        For r = 2 To lastRowDB
            If UCase(Trim(wsDB.Cells(r, 3).Value)) = currentC2 And _
               UCase(Trim(wsDB.Cells(r, 5).Value)) = selDisc Then
                wsGEN.RANGE("C4").Value = wsDB.Cells(r, 2).Value  ' Обновляем только C4
                found = True
                Exit For
            End If
        Next r
        
        ' Если не нашли комбинацию C2 + новая дисциплина, тогда меняем C2
        If Not found Then
            For r = 2 To lastRowDB
                If UCase(Trim(wsDB.Cells(r, 5).Value)) = selDisc Then  ' Column E
                    wsGEN.RANGE("C2").Value = wsDB.Cells(r, 3).Value  ' TAG_RELEVANT to C2
                    wsGEN.RANGE("C4").Value = wsDB.Cells(r, 2).Value  ' TAG_ITEM to C4
                    found = True
                    Exit For
                End If
            Next r
        End If
        
    ElseIf Target.Address = "$C$4" Then  ' TAG_ITEM_NUMBER_CCMS changed
        Dim selTag As String
        selTag = UCase(Trim(wsGEN.RANGE("C4").Value))
        For r = 2 To lastRowDB
            If UCase(Trim(wsDB.Cells(r, 2).Value)) = selTag Then  ' Column B
                wsGEN.RANGE("C2").Value = wsDB.Cells(r, 3).Value  ' TAG_RELEVANT to C2
                wsGEN.RANGE("C3").Value = wsDB.Cells(r, 5).Value  ' Discipline to C3
                found = True
                Exit For
            End If
        Next r
    End If
    
    ' Если не найдено, можно добавить логику очистки, например:
    ' If Not found Then wsGen.Range("C2:C4").ClearContents
End Sub

Public Function CountZZZ(Area As Range) As Double
Dim rCell As Range
Dim Unique As New Collection
On Error Resume Next
    
    For Each rCell In Area
        If Not IsEmpty(rCell) Then Unique.Add rCell.Value, CStr(rCell.Value)
    Next
    
CountZZZ = Unique.Count
End Function

Sub Attempt()
Dim ie As Object
Dim frm As Object
Dim frm1 As Object
Dim lst As Object
    Set ie = CreateObject("internetexplorer.application")
    ie.Visible = True
    'открываем сайт
    ie.navigate "http://ets.aeso.ca/ets_web/docroot/Market/Reports/HistoricalReportsStart.html"
    'ждёмс
    Do
    Loop Until Not (ie.Busy)
    Application.Wait Now + TimeValue("00:00:02")
'выбираем рамку (вот может тут уже неправильно присвоено)
Set frm1 = ie.document.Frames
Set frm = frm1("report_nav")
                
' может проблема здесь
Set lst = frm.document.getElementsByTagName("SelectReport")
'на вэлью появляется ошибка
lst.Value = "Market/Reports/PublicSummaryAllReportServlet"
Set lst = frm.Function("populateReportType(document.reportForm, getCurrReportObj())")
lst
    
    Set ie = Nothing
    Set frm = Nothing
    Set frm1 = Nothing
    Set lst = Nothing
    
End Sub