AddDonGia.Bas

Sub AddDonGia()
Dim Dic As Object, Rng As Range, Data As Variant, MAHH As String, I As Long, J As Long
With ActiveCell
     If .Column = 4 And .Count = 1 And .Offset(, -3).Value <> vbNullString Then
        MAHH = CStr(.Offset(, -3).Value)
        Data = Sheet1.Range("A2:D" & .Row - 1).Value
        Set Dic = CreateObject("Scripting.dictionary")
        For I = 1 To UBound(Data, 1)
            If CStr(Data(I, 1)) = MAHH Then
               If Data(I, 4) <> vbNullString Then
                  If Not Dic.exists(Data(I, 4)) Then Dic.Add Data(I, 4), ""
               End If
            End If
        Next
        If Dic.Count > 0 Then
           With Sheet2
                .Range("A1:A1048576").ClearContents
                .Range("A1").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
                With ThisWorkbook.Names.Item("DS_DONGIA")
                     .RefersTo = .RefersToRange.Resize(Dic.Count, 1)
                End With
           End With
           
           With .Validation
                .Delete
                .Add xlValidateList, , , ThisWorkbook.Names("DS_DONGIA")
           End With
        Else
           Exit Sub
        End If
     Else
        Exit Sub
     End If
End With
End Sub