Dim aMOQ, aLGH, aGIOCOLLECT, aLDH
Private Sub Worksheet_Change(ByVal Target As Range)
Dim eRow As Long, supBln As Boolean, Rng As Range
If Target.Address(0, 0) = "A3" Or Target.Address(0, 0) = "B1" Then
Call TangToc(False)
eRow = Range("A" & Rows.Count).End(xlUp).Row
If eRow > 4 Then Range("A5:K" & eRow).Clear
Call LungTung
Call TangToc(True)
End If
End Sub
Private Sub LungTung()
Dim sArr(), cArr(), Res(), S, colArr
Dim i As Long, eRow As Long, sRow As Long, k As Long
Dim Contract As String, Stastus As String, iKey
With Sheets("Car order")
cArr = .Range("B2:F" & .Range("B" & Rows.Count).End(xlUp).Row).Value
End With
With Sheets("CAR proposal")
sArr = .Range("C2:AK" & .Range("D" & Rows.Count).End(xlUp).Row).Value
End With
sRow = UBound(sArr)
With CreateObject("scripting.dictionary")
For i = 1 To UBound(cArr)
iKey = cArr(i, 1)
If .exists(iKey) = False Then .Add iKey, cArr(i, 5)
Next i
For i = 1 To sRow
iKey = sArr(i, 1)
If .exists(iKey) Then sArr(i, 10) = UCase(.Item(iKey)) Else sArr(i, 10) = ""
Next i
End With
Stastus = UCase(Left(Range("B1").Value, 3))
Contract = UCase(Range("A3").Value) & "*"
With CreateObject("scripting.dictionary")
For i = 1 To sRow
If Left(sArr(i, 10), 3) = Stastus Or Len(Stastus) = 0 Then
If UCase(sArr(i, 4)) Like Contract Then
iKey = sArr(i, 2)
If .exists(iKey) = False Then
k = k + 1
.Add iKey, Array(i)
Else
S = .Item(iKey)
ReDim Preserve S(0 To UBound(S) + 1)
S(UBound(S)) = i
.Item(iKey) = S
End If
End If
End If
Next i
If k Then
If TypeName(aMOQ) <> "Variant()" Then Call CreateArr_DuLieuTimkiem
colArr = Array(, 9, 11, 21, 22, 23, 26, 31, 32, 33, 34, 35)
k = 0
For Each iKey In .keys
eRow = Range("A" & Rows.Count).End(xlUp).Row
k = k + 1
If k > 1 Then
Range("A1:K4").Copy
Range("A" & eRow + 1).PasteSpecial Paste:=xlPasteValues
Range("A" & eRow + 1).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
eRow = eRow + 4
End If
Range("C" & eRow - 1) = iKey
Set Rng = Range("D" & eRow - 1).Resize(, 8)
Rng.ClearContents
Call Dong_3(Rng, iKey)
S = .Item(iKey)
ReDim Res(0 To UBound(S), 1 To UBound(colArr))
For n = 0 To UBound(S)
If n = 0 Then Range("B" & eRow - 1) = sArr(S(n), 3)
For j = 1 To UBound(colArr)
Res(n, j) = sArr(S(n), colArr(j))
Next j
Next n
Range("A" & eRow + 1).Resize(n).NumberFormat = "@"
Range("A" & eRow + 1).Resize(n, UBound(colArr)) = Res
Range("A" & eRow + 1).Resize(n, UBound(colArr)).Borders.LineStyle = 1
If n > 1 Then Range("A" & eRow + 1).Resize(n, UBound(colArr)).Sort Range("A" & eRow + 1), 1, Header:=xlNo
Next
eRow = Range("A" & Rows.Count).End(xlUp).Row
Range("E3:F" & eRow).NumberFormat = "#,###;[red](#,###);"
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
End If
End With
End Sub
Private Sub CreateArr_DuLieuTimkiem()
Dim wb As Workbook, eRow 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 aMOQ = .Range("B2:H" & eRow).Value
End With
With wb.Sheets("LGH")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then aLGH = .Range("B2:I" & eRow).Value
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 aGIOCOLLECT = .Range("A2:C" & eRow).Value
End With
With wb.Sheets("LDH")
If .AutoFilterMode = True Then .AutoFilterMode = False
eRow = .Range("B" & Rows.Count).End(xlUp).Row
If eRow > 1 Then aLDH = .Range("B2:P" & eRow).Value
End With
wb.Close False
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
sArr = aMOQ
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
sArr = aLGH
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
sArr = aGIOCOLLECT
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
sArr = aLDH
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 Sub
Private Sub TangToc(ByVal Bln As Boolean)
Application.EnableEvents = Bln
Application.ScreenUpdating = Bln
End Sub
