Private Sub Worksheet_Change(ByVal Target As Range)
Dim eRow As Long, Rng As Range
If Target.Address(0, 0) = "C3" Then
Range("C3").NumberFormat = "@"
Set Rng = Range("D3:K3")
Call TangToc(False)
Rng.ClearContents
If Len(Target.Value) > 0 Then
Call Dong_3(Rng, Target.Value)
Call AddDataValidation_A3(Target.Value)
End If
End If
If Target.Address(0, 0) = "A3" Then
eRow = Range("A" & Rows.Count).End(xlUp).Row
Call TangToc(False)
If eRow > 4 Then Range("A5:K" & eRow).Clear
Call Cot_A_K(Target.Value)
End If
Call TangToc(True)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(0, 0) = "C3" Then
Dim sArr(), Res(), oSList As Object
Dim i As Long, eRow As Long, sRow As Long, k As Long
Application.EnableEvents = False
Range("C3").NumberFormat = "@"
With Sheets("CAR proposal")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("D" & Rows.Count).End(xlUp).Row
sArr = .Range("D2:D" & eRow).Value
sRow = UBound(sArr)
Set oSList = CreateObject("System.Collections.SortedList")
For i = 1 To sRow
If oSList.ContainsKey(sArr(i, 1)) = False Then oSList.Add sArr(i, 1), ""
Next
k = oSList.Count - 1
ReDim Res(0 To k)
For i = 0 To k
Res(i) = oSList.GetKey(i)
Next i
Set oSList = Nothing
Range("C3").Validation.Delete
Range("C3").Validation.Add 3, , , Join(Res, ",")
End With
Application.EnableEvents = True
End If
End Sub
Private Sub AddDataValidation_A3(ByVal dk As String)
Dim sArr(), Res
Dim i As Long, eRow As Long, sRow As Long, k As Long
With Sheets("CAR proposal")
If .AutoFilterMode = True Then .AutoFilterMode = False
sArr = .Range("C2", .Range("D" & Rows.Count).End(xlUp)).Value
sRow = UBound(sArr)
End With
With CreateObject("scripting.dictionary")
For i = 1 To sRow
If sArr(i, 2) = dk Then
If .exists(sArr(i, 1)) = False Then .Add sArr(i, 1), ""
End If
Next
Range("A3").Validation.Delete
Res = .keys
Range("A3").Validation.Add 3, , , Join(Res, ",")
Call TangToc(True)
Range("A3") = Res(0)
'Call TangToc(False)
End With
End Sub
Private Sub Dong_3(ByRef Rng, ByVal iKey As String)
Dim wb As Workbook, sArr()
Dim i As Long, eRow As Long, sRow As Long
Set wb = Workbooks.Open(ThisWorkbook.Path & "\DU LIEU TIM KIEM1.xlsm")
With wb.Sheets("MOQ")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("B2:H" & eRow).Value
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) = iKey Then
If Len(sArr(i, 4)) > 0 Then
Rng(1, 1) = sArr(i, 4)
ElseIf Len(sArr(i, 7)) > 0 Then
Rng(1, 1) = sArr(i, 7)
End If
If Len(sArr(i, 3)) > 0 Then
Rng(1, 2) = sArr(i, 3)
ElseIf Len(sArr(i, 5)) > 0 Then
Rng(1, 2) = sArr(i, 5)
End If
Exit For
End If
Next i
End If
End With
With wb.Sheets("LGH")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("B2:I" & eRow).Value
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) = iKey Then
If Len(sArr(i, 8)) > 0 Then Rng(1, 3) = sArr(i, 8)
If Len(sArr(i, 3)) > 0 Then Rng(1, 4) = sArr(i, 3)
Exit For
End If
Next i
End If
End With
With wb.Sheets("GIO COLLECT")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("A" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("A2:C" & eRow).Value
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) = iKey Then
If Len(sArr(i, 3)) > 0 Then Rng(1, 5) = sArr(i, 3)
Exit For
End If
Next i
End If
End With
With wb.Sheets("LDH")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then
sArr = .Range("B2:P" & eRow).Value
sRow = UBound(sArr)
For i = 1 To sRow
If sArr(i, 1) = iKey Then
If Len(sArr(i, 15)) > 0 Then Rng(1, 6) = Replace(Application.Trim(Replace(sArr(i, 15), ",", " ")), " ", ",")
If Len(sArr(i, 4)) > 0 Then Rng(1, 7) = sArr(i, 4)
If Len(sArr(i, 5)) > 0 Then Rng(1, 8) = sArr(i, 5)
Exit For
End If
Next i
End If
End With
wb.Close False
End Sub
Private Sub Cot_A_K(ByVal iKey As String)
Dim sArr(), Res(), colArr()
Dim i As Long, eRow As Long, q As Long, sRow As Long, k As Long, j As Long
With Sheets("CAR proposal")
eRow = .Range("C" & Rows.Count).End(xlUp).Row
q = Application.CountIf(.Range("C2:C" & eRow), iKey)
If q > 0 Then sArr = .Range("C2:AK" & eRow).Value
End With
If q > 0 Then
sRow = UBound(sArr)
colArr = Array(, 9, 11, 21, 22, 23, 26, 31, 32, 33, 34, 35)
ReDim Res(1 To q, 1 To UBound(colArr))
For i = 1 To sRow
If sArr(i, 1) = iKey Then
k = k + 1
If k = 1 Then
Range("B3") = sArr(i, 3)
Range("C3") = sArr(i, 2)
End If
For j = 1 To UBound(colArr)
Res(k, j) = sArr(i, colArr(j))
Next j
End If
Next
Range("A5").Resize(k).NumberFormat = "@"
Range("A5:K5").Resize(k) = Res
Range("A5:K5").Resize(k).Borders.LineStyle = 1
If k > 1 Then Range("A5:K5").Resize(k).Sort [A5], 1, Header:=xlNo
End If
End Sub
Private Sub TangToc(ByVal Bln As Boolean)
Application.EnableEvents = Bln
Application.ScreenUpdating = Bln
End Sub
