' ============================================================ ' Module Name: Master_Kukan_detail ' Module Desc: M2 Kukan detail master data management ' Module Methods: ' - Worksheet_Change ' - FillFromM1 ' - validateButton_Click ' - Validate ' ============================================================ Private Sub Worksheet_Change(ByVal Target As Range) Dim watchArea As Range With Me Set watchArea = Union( _ .Columns("C"), _ .Columns("I:R") _ ) End With Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea) If intersectRng Is Nothing Then Exit Sub If Target.Row < 7 Then Exit Sub Application.EnableEvents = False On Error GoTo Finally ' === Fill D, E when C column changes === If Target.Column = 3 Then Dim cell As Range For Each cell In Target If Trim(cell.Value) = "" Then Call ClearRowData(Me, cell.Row) Else Call FillFromM1(cell.Row) End If Next End If ' === Create J dropdown when I column changes === If Target.Column = 9 Then Dim cellI As Range For Each cellI In Target ' clear Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents Me.Cells(cellI.Row, 11).Validation.Delete Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite Call CreateJDropdown(cellI.Row) Next End If ' === Fill K column when J column changes === If Target.Column = 10 Then Dim cellJ As Range For Each cellJ In Target Call FillKFromJ(cellJ.Row) Next End If Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value) Dim restrictedCols As Range If kenshuKbn = "1" Then Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R")) If Not Intersect(Target, restrictedCols) Is Nothing Then Application.EnableEvents = False MsgBox "can not be input", vbExclamation Application.Undo Application.EnableEvents = True Exit Sub End If Else Set restrictedCols = Me.Range("K:R") ' If Not Intersect(Target, restrictedCols) Is Nothing Then Application.EnableEvents = False MsgBox "can not be input", vbExclamation Application.Undo Application.EnableEvents = True Exit Sub End If End If Finally: Application.EnableEvents = True ' End Sub Private Sub FillKFromJ(ByVal rowNum As Long) Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value) Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value) Dim code As String: code = GetCode(jValue) If jValue = "" Then Me.Range("K" & rowNum).ClearContents Exit Sub End If ' Get cache based on I column value Dim cache As Object Select Case iValue Case "1" Set cache = GetT1Cache() Case "2" Set cache = GetT2Cache() Case "3" Set cache = GetT3Cache() Case Else Exit Sub End Select If cache Is Nothing Then Exit Sub ' Check if J value exists in cache If cache.Exists(code) Then Dim cacheVal As Variant: cacheVal = cache(code) Me.Range("J" & rowNum).Value = Trim(code) Me.Range("K" & rowNum).Value = Trim(cacheVal(0)) End If Select Case iValue Case "1" Exit Sub Case "2" Me.Range("L" & rowNum).Value = Trim(cacheVal(2)) Me.Range("M" & rowNum).Value = Trim(cacheVal(3)) Me.Range("N" & rowNum).Value = Trim(cacheVal(4)) Me.Range("O" & rowNum).Value = Trim(cacheVal(5)) Me.Range("P" & rowNum).Value = Trim(cacheVal(6)) Me.Range("Q" & rowNum).Value = Trim(cacheVal(7)) Case "3" Me.Range("L" & rowNum).Value = Trim(cacheVal(1)) Me.Range("M" & rowNum).Value = Trim(cacheVal(2)) Case Else Exit Sub End Select End Sub Private Sub CreateJDropdown(ByVal rowNum As Long) Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value) Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum) ' Clear existing validation targetCell.Validation.Delete targetCell.ClearContents ' Get cache based on I column value Dim cache As Object Select Case iValue Case "1" Set cache = GetT1Cache() Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192) Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192) Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192) Case "2" Set cache = GetT2Cache() Case "3" Set cache = GetT3Cache() Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192) Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192) Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192) Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192) Case Else Exit Sub End Select If cache Is Nothing Then Exit Sub ' Build dropdown list from cache Dim dropdownList As String: dropdownList = "" Dim key As Variant For Each key In cache.Keys Dim displayText As String: displayText = MakeSelect(key, cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else dropdownList = dropdownList & "," & displayText End If Next key If dropdownList <> "" Then With targetCell.Validation .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End If End Sub Private Sub FillFromM1(ByVal rowNum As Long) Set ws = Me Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) ' Fill D, E, F, G, H columns from M1 cache ' D = cache[1]: cache[2] (col 4: col 5) ' E = cache[3] (col 6) ' F = cache[4] (col 7) ' G = cache[5] (col 9) ' H = cache[6] (col 12) ' Check C column in the cache If Not m1Cache.Exists(cValue) Then ws.Cells(rowNum, 4).Value = "" ws.Cells(rowNum, 5).Value = "" ws.Cells(rowNum, 6).Value = "" ws.Cells(rowNum, 7).Value = "" ws.Cells(rowNum, 8).Value = "" Exit Sub End If Dim cacheVal As Variant: cacheVal = m1Cache(cValue) ' D column = cache[1]: cache[2] ws.Cells(rowNum, 4).Value = Trim(cacheVal(1)) & ":" & Trim(cacheVal(2)) ' E column = cache[3] ws.Cells(rowNum, 5).Value = Trim(cacheVal(3)) ' F column = cache[4] ws.Cells(rowNum, 6).Value = Trim(cacheVal(4)) ' G column = cache[5] ws.Cells(rowNum, 7).Value = Trim(cacheVal(5)) ' H column = cache[6] ws.Cells(rowNum, 8).Value = Trim(cacheVal(6)) End Sub Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) ' Clear from D column onwards ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Cells(rowNum, 6).Validation.Delete ws.Cells(rowNum, 19).ClearContents ' Q column error info End Sub Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) Dim startCol As String: startCol = sheetConf("StartCol") Dim endCol As String: endCol = sheetConf("EndCol") Dim errorCol As String: errorCol = sheetConf("ErrorCol") Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite ' Check C column in the cache Dim m1Cache As Object: Set m1Cache = GetM1Cache() ' C column check checkResult = CheckRequired(ws, rowNum, 3, errorCol) If checkResult = False Then Exit Sub Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) If Not m1Cache.Exists(cValue) Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "C" & rowNum) ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' Check column required Dim colLetter As Variant For Each colLetter In Array("I", "J", "K", "L", "M") If Trim(ws.Range(colLetter & rowNum).Value) = "" Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next colLetter ' Check column numeric (only if has value) Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R") Dim col As Variant For Each col In numericCols Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "") If val <> "" And Not IsNumeric(val) Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", col & rowNum) ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next col ' Check I column in the kenshuKbn Dim kenshuList As Object: Set kenshuList = GetKenshuList() Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value) If Not kenshuList.Exists(kenshuKbn) Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum) ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' Check J column in the T1, T2, T3 Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) Dim name As String: name = Trim(ws.Range("K" & rowNum).Value) Dim valueL As String: valueL = Trim(ws.Range("L" & rowNum).Value) Dim valueM As String: valueM = Trim(ws.Range("M" & rowNum).Value) Dim valueN As String: valueN = Trim(ws.Range("N" & rowNum).Value) Dim valueO As String: valueO = Trim(ws.Range("O" & rowNum).Value) Dim valueP As String: valueP = Trim(ws.Range("P" & rowNum).Value) Dim valueQ As String: valueQ = Trim(ws.Range("Q" & rowNum).Value) Dim cache As Object Dim requiredCols As Variant Dim equaledCols As Variant Dim emptyCols As Variant If kenshuKbn = "1" Then Set cache = GetT1Cache() ' must input equaledCols = Array("K") requiredCols = Array("N") emptyCols = Array("O", "P", "Q", "R") End If If kenshuKbn = "2" Then Set cache = GetT2Cache() ' must input equaledCols = Array("K", "L", "M", "N", "O", "P", "Q") requiredCols = Array("N", "O", "P", "Q") emptyCols = Array("R") End If If kenshuKbn = "3" Then Set cache = GetT3Cache() ' must input equaledCols = Array("K", "L", "M") requiredCols = Array() emptyCols = Array("N", "O", "P", "Q", "R") End If ' code not exist check If Not cache.Exists(code) Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "J" & rowNum) ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' Dim equaledColIndex As Long ' For equaledColIndex = 0 To ' Dim equaledCol As Variant ' For Each equaledCol In equaledCols ' Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value) ' cache ' If cache(code)(0) <> name Then ' Exit Sub ' End If ' Me.Range(equaledCol & rowNum).Validation.Delete ' Next equaledCol Dim requiredCol As Variant For Each requiredCol In requiredCols Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value) If requiredValue = "" Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", requiredCol & rowNum) ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next requiredCol Dim emptyCol As Variant For Each emptyCol In emptyCols Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value) If emptyValue <> "" Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", emptyCol & rowNum) ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next emptyCol ' check Duplicate Dim i As Long For i = 7 To rowNum - 1 If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue) ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) Exit Sub End If If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "K").Value) = name Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue) ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0) Exit Sub End If Next i ws.Cells(rowNum, errorCol).ClearContents End Sub Sub ImportCSVAndTriggerChange(ws As Worksheet) ' TODO End Sub