Option Explicit
Private Sub Worksheet_Activate()
Dim lr&, i&, rng
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
rng = .Range("B6:B" & lr).Value2
For i = 1 To UBound(rng)
If Not dic.exists(rng(i, 1)) Then dic.Add rng(i, 1), ""
Next
End With
Range("CV2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
lr = Cells(Rows.Count, "CV").End(xlUp).Row
ActiveWorkbook.Names.Add "ngay", Range("CV2:CV" & lr)
On Error Resume Next
Range("A2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=ngay"
Set dic = Nothing
Columns("CV:CY").Hidden = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, rng
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
If Target.Address(0, 0) = "A2" Then
If IsEmpty(Target) Then
Range("B2").ClearContents
Exit Sub
End If
With Sheets("Sheet2")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
rng = .Range("B6:C" & lr).Value
For i = 1 To UBound(rng)
If rng(i, 1) = Target Then
If Not dic.exists(rng(i, 2)) Then dic.Add rng(i, 2), ""
End If
Next
End With
Range("CW2:CW10000").ClearContents
Range("CW2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
lr = Cells(Rows.Count, "CW").End(xlUp).Row
ActiveWorkbook.Names.Add "job", Range("CW2:CW" & lr)
If WorksheetFunction.CountIf(Range("job"), Range("B2")) = 0 Then Range("B2").ClearContents
On Error Resume Next
Range("B2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=job"
Set dic = Nothing
ElseIf Target.Address(0, 0) = "B2" Then
If IsEmpty(Target) Then
Range("C2").ClearContents
Exit Sub
End If
With Sheets("Sheet2")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
rng = .Range("B6:D" & lr).Value
For i = 1 To UBound(rng)
If rng(i, 1) = Range("A2") And rng(i, 2) = Target Then
If Not dic.exists(rng(i, 3)) Then dic.Add rng(i, 3), ""
End If
Next
End With
Range("CX2:CX10000").ClearContents
Range("CX2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
lr = Cells(Rows.Count, "CX").End(xlUp).Row
ActiveWorkbook.Names.Add "sig", Range("CX2:CX" & lr)
If WorksheetFunction.CountIf(Range("sig"), Range("C2")) = 0 Then Range("C2").ClearContents
On Error Resume Next
Range("C2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=sig"
Set dic = Nothing
ElseIf Target.Address(0, 0) = "C2" Then
If IsEmpty(Target) Then
Range("D2").ClearContents
Exit Sub
End If
On Error Resume Next
With Sheets("Sheet2")
lr = .Cells(Rows.Count, "B").End(xlUp).Row
rng = .Range("B6:E" & lr).Value
For i = 1 To UBound(rng)
If rng(i, 1) = Range("A2") And rng(i, 2) = Range("B2") And rng(i, 3) = Target.Value Then
If Not dic.exists(rng(i, 4)) Then dic.Add rng(i, 4), ""
End If
Next
End With
Range("CY2:CY10000").ClearContents
Range("CY2").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
lr = Cells(Rows.Count, "CY").End(xlUp).Row
ActiveWorkbook.Names.Add "id", Range("CY2:CY" & lr)
If WorksheetFunction.CountIf(Range("id"), Range("D2")) = 0 Then Range("D2").ClearContents
Range("D2").Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=id"
Set dic = Nothing
End If
End Sub
[/code]
