' ============================================================ ' Module Name: Tukin_C1 ' Module Desc: Commuter allowance editing sheet (no CSV import) ' Module Methods: ' - Tukin_ValidateRow ' - FillTransportFromM1KukanD ' - FillDepartureFromM1KukanD ' - FillArrivalFromM1KukanD ' - FillKukanFromM1 ' - FillKanshuFromM2 ' - FillCodeFromM2 ' - BuildAddress1Dropdown ' - FillZ1Dropdown ' ============================================================ ' ====== (Tukin_C1) ======= ' Commuter allowance editing sheet ' No CSV import - direct editing only ' ============================================================ ' Column arrays for 4 kukan sections ' ============================================================ Const CSHAINNO_COL As String = "C" Const ADDRESS1_COL As String = "I" Const ADDRESS2_COL As String = "J" Const MMONTH_AMOUNT_KBN_COL As String = "BB" Private Function KUKAN_CODE_COLS() As Variant KUKAN_CODE_COLS = Array(19, 27, 35, 43) ' S, AA, AI, AQ End Function Private Function KUKAN_TRANSPORT_COLS() As Variant KUKAN_TRANSPORT_COLS = Array(20, 28, 36, 44) ' T, AB, AJ, AR End Function Private Function KUKAN_STATION_COLS() As Variant KUKAN_STATION_COLS = Array(21, 29, 37, 45) ' U, AC, AK, AS End Function Private Function KUKAN_ARRIVAL_COLS() As Variant KUKAN_ARRIVAL_COLS = Array(22, 30, 38, 46) ' V, AD, AL, AT End Function Private Function KUKAN_TICKET_COLS() As Variant KUKAN_TICKET_COLS = Array(23, 31, 39, 47) ' W, AE, AM, AU End Function Private Function KUKAN_CODE2_COLS() As Variant KUKAN_CODE2_COLS = Array(24, 32, 40, 48) ' X, AF, AN, AV End Function Private Function KUKAN_TEIKI_COLS() As Variant KUKAN_TEIKI_COLS = Array(25, 33, 41, 49) ' Y, AG, AO, AW End Function Private Function KUKAN_START_DAY_COLS() As Variant KUKAN_START_DAY_COLS = Array(26, 34, 42, 50) ' Z, AH, AP, AX End Function Private Function DATE_COLS() As Variant DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 56, 59) ' D, E, F, Z, AH, AP, AX, BC, BF End Function Private Function NUMBER_COLS() As Variant NUMBER_COLS = Array("L", "P", "Q", "R") End Function ' ============================================================ ' Helper: Get index by value, return -1 if not found ' ============================================================ Private Function GetIdx(val As Long, arr As Variant) As Long Dim i As Long For i = LBound(arr) To UBound(arr) If arr(i) = val Then GetIdx = i Exit Function End If Next i GetIdx = -1 End Function ' ============================================================ ' Event Handlers ' ============================================================ Private Sub Worksheet_Change(ByVal Target As Range) Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target) If HasHeaderEdit = True Then Exit Sub Dim watchArea As Range With Me Set watchArea = Union( _ .Columns("C"), _ .Columns("D"), _ .Columns("E"), _ .Columns("F"), _ .Columns("G"), _ .Columns("I"), _ .Columns("S:X"), _ .Columns("AA:AF"), _ .Columns("AI:AN"), _ .Columns("AQ:AV") _ ) End With Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea) If intersectRng Is Nothing Then Exit Sub If Target.Row < 8 Then Exit Sub Dim idx As Long ' Check if cache is loaded Application.EnableEvents = False On Error GoTo Finally Dim testCache As Object: Set testCache = GetCache("Z1") ' === Column C changes === If Target.Column = 3 Then Dim cell As Range For Each cell In Target Dim cshainno As String: cshainno = Trim(cell.Value) If cshainno = "" Then Call ClearRowData(cell.Row) Else ' rebuild dropdown list Call BuildAddress1Dropdown(cell.Row, cshainno) Call ReFillAddress1(cell.Row, cshainno) Call BuildAddress2Dropdown(cell.Row, cshainno) Call ReFillAddress2(cell.Row, cshainno) Call RebuildDropdowns(cell.Row) End If Next End If ' auto fill G column [todoke biko] If Target.Column = 7 Then Dim cellG As Range For Each cellG In Target Dim todoke As String: todoke = Trim(cellG.Value) If todoke <> "" Then Dim z4Cache As Object: Set z4Cache = GetCache("Z4") Dim todokeCde As String: todokeCde = GetCode(todoke) If z4Cache.Exists(todokeCde) Then Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8) cellH.Value = z4Cache(todokeCde)(0) End If End If Next End If ' === Column I changes === If Target.Column = 9 Then Dim cellI As Range For Each cellI In Target Call BuildAddress2Dropdown(cellI.Row, Trim(Me.Cells(cellI.Row, CSHAINNO_COL).Value)) Next End If ' === Date columns changes === idx = GetIdx(Target.Column, DATE_COLS) If idx >= 0 Then Dim cellDate As Range For Each cellDate In Target If Trim(cellDate.Value) <> "" Then Dim formattedDate As String: formattedDate = FormatDateInput(cellDate.Value) cellDate.Value = FormatDateInput(formattedDate) If cellDate.Column = 5 Then Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6) If Trim(fCell.Value) = "" Then fCell.Value = formattedDate End If End If End If Next End If ' === Transport column changes (T, AB, AJ, AR) === idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS) If idx >= 0 Then Dim cellT As Range For Each cellT In Target Me.Cells(cellT.Row, KUKAN_STATION_COLS(idx)).ClearContents Me.Cells(cellT.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents If Trim(cellT.Value) <> "" Then Call CreateFromStationDropdown(cellT.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx)) End If Next End If ' === Station column changes (U, AC, AK, AS) === idx = GetIdx(Target.Column, KUKAN_STATION_COLS) If idx >= 0 Then Dim cellU As Range For Each cellU In Target ' Clear arrival value first Me.Cells(cellU.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents If Trim(cellU.Value) <> "" Then Call CreateToStationDropdown(cellU.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx)) End If Next End If ' === Arrival column changes (V, AD, AL, AT) === idx = GetIdx(Target.Column, KUKAN_ARRIVAL_COLS) If idx >= 0 Then Dim cellV As Range For Each cellV In Target If Trim(cellV.Value) <> "" Then ' Reverse lookup: find kukan code by transport + from + to Dim foundCode As String foundCode = FindKukanCodeByStation(cellV.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx)) If foundCode <> "" Then Me.Cells(cellV.Row, KUKAN_CODE_COLS(idx)).Value = foundCode Call CreateKenshuDropdown(cellV.Row, idx, foundCode) End If End If Next End If ' === Kukan code column changes (S, AA, AI, AQ) === idx = GetIdx(Target.Column, KUKAN_CODE_COLS) If idx >= 0 Then Dim cellK As Range For Each cellK In Target Call FillKukanFromM1(cellK.Row, idx) Next End If ' === Ticket column changes (W, AE, AM, AU) === idx = GetIdx(Target.Column, KUKAN_TICKET_COLS) If idx >= 0 Then Dim cellTi As Range For Each cellTi In Target ' Clear old code first Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx) Me.Cells(cellTi.Row, code2Col).ClearContents Me.Cells(cellTi.Row, code2Col).Validation.Delete ' Also clear teiki column Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(idx) Me.Cells(cellTi.Row, teikiCol).ClearContents Me.Cells(cellTi.Row, teikiCol).Validation.Delete Call BuildM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col) Next End If ' === Code2 column changes (X, AF, AN, AV) === idx = GetIdx(Target.Column, KUKAN_CODE2_COLS) If idx >= 0 Then Dim cellCode2 As Range For Each cellCode2 In Target If Trim(cellCode2.Value) <> "" Then Call CreateTeikiDropdown(cellCode2.Row, idx) End If Next End If Application.EnableEvents = True Exit Sub Finally: HandleError "Worksheet_Change" Application.EnableEvents = True ' End Sub ' Prevent insert/delete row in header area Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName) Dim filterRow As Long: filterRow = sheetConf("FilterRow") If Target.Row < filterRow + 1 Then Cancel = True MsgBox "Cannot insert or delete row in header area.", vbExclamation End If End Sub Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long) Dim z1Cache As Object: Set z1Cache = GetCache("Z1") Application.EnableEvents = False On Error GoTo ErrorHandler Dim r As Long For r = startRow To lastDataRow Dim cshainno As String: cshainno = Trim(Me.Cells(r, CSHAINNO_COL).Value) Call BuildAddress1Dropdown(r, cshainno) Call ReFillAddress1(r, cshainno) Call BuildAddress2Dropdown(r, cshainno) Call ReFillAddress2(r, cshainno) Call RebuildDropdowns(r) Call ReFillFromDropdowns(r) ' Refresh teiki dropdowns for all 4 sections Dim idx As Long For idx = 0 To 3 Dim kukanCode As String: kukanCode = Trim(Me.Cells(r, KUKAN_CODE_COLS(idx)).Value) Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(r, KUKAN_TICKET_COLS(idx)).Value)) Dim code As String: code = GetCode(Trim(Me.Cells(r, KUKAN_CODE2_COLS(idx)).Value)) Call BuildM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx)) Call ReFillM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx)) If kukanCode <> "" And kenshu <> "" And code <> "" Then Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx) Call BuildTeikiDropdown(r, kukanCode, kenshu, code, ColLetter(teikiColIndex)) End If Next idx Next r Application.EnableEvents = True Exit Sub ErrorHandler: Application.EnableEvents = True Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description End Sub Private Sub RebuildDropdowns(ByVal rowNum As Long) Dim dropdowns As Variant dropdowns = Array( _ Array("T", "BuildTransportList"), _ Array("AB", "BuildTransportList"), _ Array("AJ", "BuildTransportList"), _ Array("AR", "BuildTransportList"), _ Array("G", "BuildTodokeList"), _ Array("M", "BuildOufukuList"), _ Array("N", "BuildKoutaiList"), _ Array("AY", "BuildKetteiList"), _ Array("BA", "BuildHigaitouList"), _ Array("BG", "BuildKanshokuList") _ ) Dim i As Long For i = LBound(dropdowns) To UBound(dropdowns) With Me.Cells(rowNum, dropdowns(i)(0)).Validation .Delete .Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1)) .IgnoreBlank = True .InCellDropdown = True End With Next i Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, "Z3") End Sub Private Sub ReFillFromDropdowns(ByVal rowNum As Long) Dim z3Cache As Object: Set z3Cache = GetCache("Z3") Dim valueStrMonthAmountKbn As String: valueStrMonthAmountKbn = Trim(Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value) Dim monthAmountKbn As String: monthAmountKbn = GetCode(valueStrMonthAmountKbn) If z3Cache.Exists(monthAmountKbn) Then Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value = MakeSelect(monthAmountKbn, z3Cache(monthAmountKbn)(0)) End If Dim dropdowns As Variant dropdowns = Array( _ Array("T", "BuildTransportList"), _ Array("AB", "BuildTransportList"), _ Array("AJ", "BuildTransportList"), _ Array("AR", "BuildTransportList"), _ Array("G", "BuildTodokeList"), _ Array("M", "BuildOufukuList"), _ Array("N", "BuildKoutaiList"), _ Array("AY", "BuildKetteiList"), _ Array("BA", "BuildHigaitouList"), _ Array("BG", "BuildKanshokuList") _ ) Dim i As Long For i = LBound(dropdowns) To UBound(dropdowns) Dim col As String: col = dropdowns(i)(0) Dim funcName As String: funcName = dropdowns(i)(1) Dim cellValue As String: cellValue = Trim(Me.Cells(rowNum, col).Value) If cellValue = "" Then GoTo NextDropdown Dim key As String: key = GetCode(cellValue) If InStr(cellValue, ":") = 0 Then GoTo NextDropdown ' Skip if not key:value format ' Get dropdown list Dim dropdownList As String: dropdownList = Application.Run(funcName) Dim items As Variant: items = Split(dropdownList, ",") ' Check if key exists in dropdown Dim j As Long For j = LBound(items) To UBound(items) Dim item As String: item = Trim(items(j)) If GetCode(item) = key Then ' Found matching key, update with full key:value Me.Cells(rowNum, col).Value = item Exit For End If Next j NextDropdown: Next i End Sub ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long) Dim m1Cache As Object: Set m1Cache = GetCache("M1") Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx) Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx) Dim stationCol As Long: stationCol = KUKAN_STATION_COLS(idx) Dim arrivalCol As Long: arrivalCol = KUKAN_ARRIVAL_COLS(idx) Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx) Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx) Dim startDayCol As Long: startDayCol = KUKAN_START_DAY_COLS(idx) Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value) If code <> "" And m1Cache.Exists(code) Then Dim vals As Variant: vals = m1Cache(code) Me.Cells(rowNum, transportCol).Value = MakeSelect(vals(1), vals(2)) Me.Cells(rowNum, stationCol).Value = Trim(vals(3)) Me.Cells(rowNum, arrivalCol).Value = Trim(vals(4)) Call CreateKenshuDropdown(rowNum, idx, code) Else Me.Cells(rowNum, transportCol).ClearContents Me.Cells(rowNum, stationCol).ClearContents Me.Cells(rowNum, arrivalCol).ClearContents Me.Cells(rowNum, startDayCol).ClearContents Call ClearKukanValidation(rowNum, stationCol) Call ClearKukanValidation(rowNum, arrivalCol) Call ClearKukanValidation(rowNum, code2Col) End If Me.Cells(rowNum, ticketCol).ClearContents Me.Cells(rowNum, code2Col).ClearContents End Sub ' triggered by c clomun cshainno input ' when cshainno does not exist in o1, clear dropdownList and value ' when cshainno exist in o1, create dropdownList and value Private Sub BuildAddress1Dropdown(ByVal rowNum As Long, ByVal cshainno As String) Dim o1Cache As Object: Set o1Cache = GetCache("O1") ' Build dropdown list from O1 cache: get all E values for the C Dim dropdownList As String If o1Cache.Exists(cshainno) Then Dim innerDict As Object Set innerDict = o1Cache(cshainno) Dim eKey As Variant For Each eKey In innerDict.Keys If dropdownList = "" Then dropdownList = eKey Else dropdownList = dropdownList & "," & eKey End If Next eKey End If ' Create dropdown for I column address1 If dropdownList <> "" Then With Me.Range("I" & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .InputMessage = "" End With End If End Sub Private Sub ReFillAddress1(ByVal rowNum As Long, ByVal cshainno As String) Dim o1Cache As Object: Set o1Cache = GetCache("O1") If Not o1Cache.Exists(cshainno) Then Me.Cells(rowNum, ADDRESS1_COL).Value = "" Exit Sub End If Dim innerDict As Object: Set innerDict = o1Cache(cshainno) If innerDict.Count = 1 Then ' Auto-fill if only one key exists Dim keys As Variant: keys = innerDict.Keys Me.Cells(rowNum, ADDRESS1_COL).Value = keys(0) Exit Sub End If Dim originalValue As String: originalValue = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) If originalValue = "" Then Exit Sub ' Clear if value not found in O1 cache keys If Not innerDict.Exists(originalValue) Then Me.Cells(rowNum, ADDRESS1_COL).Value = "" End If End Sub ' triggered by address1 select O1 cache Private Sub BuildAddress2Dropdown(ByVal rowNum As Long, ByVal cshainno As String) ' Clear address2 contents ' obtain cshainno, address1, o1Cache Dim o1Cache As Object: Set o1Cache = GetCache("O1") Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) If cshainno = "" OR address1 = "" Then Exit Sub End If ' Build dropdown list from O1 cache Dim dropdownList As String If o1Cache.Exists(cshainno) Then Dim innerDict As Object Set innerDict = o1Cache(cshainno) If innerDict.Exists(address1) Then Dim addr2Dict As Object Set addr2Dict = innerDict(address1) Dim addr2Key As Variant For Each addr2Key In addr2Dict.Keys If dropdownList = "" Then dropdownList = addr2Key Else dropdownList = dropdownList & "," & addr2Key End If Next addr2Key End If End If ' Create dropdown for J column If dropdownList <> "" Then With Me.Range("J" & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .InputMessage = "" End With End If End Sub Private Sub ReFillAddress2(ByVal rowNum As Long, ByVal cshainno As String) Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ADDRESS1_COL).Value) If address1 = "" Then Me.Cells(rowNum, ADDRESS2_COL).Value = "" Exit Sub End If Dim o1Cache As Object: Set o1Cache = GetCache("O1") If Not o1Cache.Exists(cshainno) Then Me.Cells(rowNum, ADDRESS2_COL).Value = "" Exit Sub End If Dim innerDict As Object: Set innerDict = o1Cache(cshainno) If Not innerDict.Exists(address1) Then Me.Cells(rowNum, ADDRESS2_COL).Value = "" Exit Sub End If Dim addr2Dict As Object: Set addr2Dict = innerDict(address1) If addr2Dict.Count = 1 Then Dim keys As Variant: keys = addr2Dict.Keys Me.Cells(rowNum, ADDRESS2_COL).Value = keys(0) Exit Sub End If Me.Cells(rowNum, ADDRESS2_COL).Value = "" End Sub ' Create station from dropdown from M1_KukanD cache Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache") Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value) If transport = "" Then Exit Sub ' Build dropdown list from M1_KukanD cache: get all F values for the transport (D) Dim dropdownList As String If m1KukanDCache.Exists(transport) Then Dim innerDict As Object: Set innerDict = m1KukanDCache(transport) Dim fValue As Variant For Each fValue In innerDict.Keys If dropdownList = "" Then dropdownList = fValue Else dropdownList = dropdownList & "," & fValue End If Next fValue End If If dropdownList <> "" Then With Me.Cells(rowNum, stationCol).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End If End Sub ' Create Kenshu dropdown from ' Structure: { D: { F: [G] } } Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String) Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList") Dim m2Cache As Object: Set m2Cache = GetCache("M2") Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx) Me.Cells(rowNum, ticketCol).ClearContents Call ClearKukanValidation(rowNum, ticketCol) Dim kanshuDict As Object if m2Cache.Exists(kukanCode) Then Set kanshuDict = m2Cache(kukanCode) End If Dim dropdownList As String: dropdownList = MakeSelect("0", kenshuList("0")(0)) If Not kanshuDict Is Nothing Then Dim key As Variant For Each key In kenshuList.Keys If kanshuDict.Exists(key) Then dropdownList = dropdownList & "," & MakeSelect(key, kenshuList(key)(0)) End If Next key End If With Me.Cells(rowNum, ticketCol).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End Sub ' Create destination dropdown from M1_KukanD cache ' Structure: { D: { F: [G] } } Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache") Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value) Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value) If transport = "" Or stationFrom = "" Then Exit Sub ' Build dropdown list from M1_KukanD cache Dim dropdownList As String If m1KukanDCache.Exists(transport) Then Dim innerDict As Object: Set innerDict = m1KukanDCache(transport) If innerDict.Exists(stationFrom) Then Dim arr As Object: Set arr = innerDict(stationFrom) Dim gValue As Variant For Each gValue In arr.Keys If dropdownList = "" Then dropdownList = gValue Else dropdownList = dropdownList & "," & gValue End If Next gValue End If End If If dropdownList <> "" Then With Me.Cells(rowNum, stationToCol).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End If End Sub ' Find kukan code by transport + station_from + station_to (reverse lookup) Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String Dim m1Cache As Object: Set m1Cache = GetCache("M1") Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value)) Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value) Dim stationTo As String: stationTo = Trim(Me.Cells(rowNum, stationToCol).Value) If transportKbn = "" Or stationFrom = "" Or stationTo = "" Then FindKukanCodeByStation = "" Exit Function End If Dim code As Variant For Each code In m1Cache.Keys Dim vals As Variant: vals = m1Cache(code) ' vals(1) = D列, vals(3) = F列, vals(4) = G列 If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then FindKukanCodeByStation = code Exit Function End If Next code FindKukanCodeByStation = "" End Function ' Clear validation for kukan columns Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long) Me.Cells(rowNum, col).Validation.Delete End Sub ' Create dropdown from M2 cache: get code (J) list for kukanCode + kanshu Private Sub BuildM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) Dim m2Cache As Object: Set m2Cache = GetCache("M2") Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value) Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value) If kukanCode = "" Or kanshuStr = "" Then Exit Sub ' Build dropdown list: get all code for kukanCode + kanshuStr Dim dropdownList As String If m2Cache.Exists(kukanCode) Then Dim innerDict As Object: Set innerDict = m2Cache(kukanCode) Dim kanshu As String: kanshu = GetCode(kanshuStr) If innerDict.Exists(kanshu) Then Dim innermostDict As Object: Set innermostDict = innerDict(kanshu) Dim code As Variant For Each code In innermostDict.Keys Dim infoDict As Object: Set infoDict = innermostDict(code) Dim codeName As String: codeName = infoDict("name") If dropdownList = "" Then dropdownList = MakeSelect(code, codeName) Else dropdownList = dropdownList & "," & MakeSelect(code, codeName) End If Next code End If End If If dropdownList <> "" Then With Me.Cells(rowNum, codeCol).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End If End Sub Private Sub ReFillM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) Dim m2Cache As Object: Set m2Cache = GetCache("M2") Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value) Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(rowNum, kanshuCol).Value)) If kukanCode = "" Or kenshu = "" Then Me.Cells(rowNum, codeCol).ClearContents Me.Cells(rowNum, codeCol).Validation.Delete Me.Cells(rowNum, codeCol).Interior.Color = vbWhite Exit Sub End If Dim code As String: code = GetCode(Trim(Me.Cells(rowNum, codeCol).Value)) If m2Cache.Exists(kukanCode) Then Dim innerDict As Object: Set innerDict = m2Cache(kukanCode) If innerDict.Exists(kenshu) Then Dim innermostDict As Object: Set innermostDict = innerDict(kenshu) If innermostDict.Exists(code) Then Dim infoDict As Object: Set infoDict = innermostDict(code) Dim codeName As String: codeName = infoDict("name") Me.Cells(rowNum, codeCol).Value = MakeSelect(code, codeName) End IF End If End If End Sub ' Clear row data and validation Private Sub ClearRowData(ByVal rowNum As Long) Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName) Dim startCol As String: startCol = sheetConf("ErrorCol") Dim endCol As String: endCol = sheetConf("EndCol") Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Validation.Delete Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite End Sub ' Validation logic Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) On Error GoTo ErrHandler 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 ' Required columns: C-G, K-N, AW Dim requiredCols As Variant requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "BA") Dim col As Variant For Each col In requiredCols If Trim(Me.Range(col & rowNum).Value & "") = "" Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", col & rowNum) Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next col ' validate date Dim colIndex As Variant For Each colIndex In DATE_COLS() Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value) If cellDate <> "" And Not IsDate(cellDate) Then Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1) Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum) Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next colIndex ' validate number For Each col In NUMBER_COLS() Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value) If cellNumber <> "" And Not IsNumeric(cellNumber) Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", col & rowNum) Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next col ' validate CodeSelect ' G column [todoke Cde] Dim ColG As String: ColG = "G" Dim z4Cache As Object: Set z4Cache = GetCache("Z4") Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value)) If Not z4Cache.Exists(todokeCde) Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum) Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' I column [address1 J column address2] Dim o1Cache As Object: Set o1Cache = GetCache("O1") Dim ColI As String: ColI = "I" Dim ColJ As String: ColJ = "J" Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value) Dim address2 As String: address2 = Trim(Me.Cells(rowNum, ColJ).Value) If address1 = "" Then If address2 <> "" Then Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Else Dim empNo As String: empNo = Trim(Me.Cells(rowNum, 3).Value) If Not o1Cache.Exists(empNo) Then Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Dim innerDict As Object: Set innerDict = o1Cache(empNo) If Not innerDict.Exists(address1) Then Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Dim addr2Dict As Object: Set addr2Dict = innerDict(address1) If Not addr2Dict.Exists(address2) Then Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If ' K column Dim ColK As String: ColK = "K" If Trim(Me.Cells(rowNum, ColK).Value) <> "" Then Me.Cells(rowNum, errorCol).Value = ColK & " column can not be input" Me.Range(ColK & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' validate CodeSelect ' M column [oufuku] Dim ColM As String: ColM = "M" Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList") Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value)) If Not oufukuList.Exists(oufukuCde) Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum) Me.Range(ColM & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' validate CodeSelect ' N column [koutai] Dim ColN As String: ColN = "N" Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList") Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value)) If Not koutaiList.Exists(koutaiCde) Then Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid" Me.Range(ColN & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns Dim m1Cache As Object: Set m1Cache = GetCache("M1") Dim m2Cache As Object: Set m2Cache = GetCache("M2") Dim kukanCols As Variant kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS) Dim kukanIdx As Long For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS) Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(kukanIdx) Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value) Dim kukanLetter As String: kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) If kukanCode <> "" Then ' KUKAN_CODE has value, check if exists in m1Cache If Not m1Cache.Exists(kukanCode) Then Me.Cells(rowNum, errorCol).Value = kukanLetter & " column does not exist" Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' Validate KUKAN_TICKET_COLS and KUKAN_CODE2_COLS Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx) Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx) Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx) Dim ticketVal As String: ticketVal = GetCode(Trim(Me.Cells(rowNum, ticketCol).Value)) Dim code2Val As String: code2Val = GetCode(Trim(Me.Cells(rowNum, code2Col).Value)) Dim ticketLetter As String: ticketLetter = Split(Me.Cells(1, ticketCol).Address, "$")(1) Dim code2Letter As String: code2Letter = Split(Me.Cells(1, code2Col).Address, "$")(1) If ticketVal = "" Then Me.Cells(rowNum, errorCol).Value = ticketLetter & " column must be input" Me.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If If ticketVal = "0" Then If code2Val <> "" Then Me.Cells(rowNum, errorCol).Value = code2Letter & " column is invalid" Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Else ' Check if ticket exists in m2Cache for this kukanCode Dim kanshuDict As Object If m2Cache.Exists(kukanCode) Then Set kanshuDict = m2Cache(kukanCode) If Not kanshuDict.Exists(ticketVal) Then Me.Cells(rowNum, errorCol).Value = ticketLetter & " column is invalid" Me.Range(ticketLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' If code2 also has value, verify it exists in m2Cache If code2Val = "" Then Me.Cells(rowNum, errorCol).Value = code2Letter & " column should be input" Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub Else Dim codeDict As Object: Set codeDict = kanshuDict(ticketVal) If Not codeDict.Exists(code2Val) Then Me.Cells(rowNum, errorCol).Value = code2Letter & " column is invalid" Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub Else Dim teikiValue As String: teikiValue = Trim(Me.Cells(rowNum, teikiCol).Value) If ticketVal = "1" And teikiValue = "" Then Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol) Me.Cells(rowNum, errorCol).Value = teikiLetter & " column is required" Me.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If End If End If End If Else ' KUKAN_CODE is empty, check that related columns are also empty Dim colGroup As Variant For Each colGroup In kukanCols Dim checkCol As Long: checkCol = colGroup(kukanIdx) Dim checkVal As String: checkVal = Trim(Me.Cells(rowNum, checkCol).Value) If checkVal <> "" Then Dim checkLetter As String: checkLetter = Split(Me.Cells(1, checkCol).Address, "$")(1) Me.Cells(rowNum, errorCol).Value = checkLetter & " column requires " & kukanLetter & " column" Me.Range(checkLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next colGroup End If Next kukanIdx ' Validate KUKAN_CODE_COLS for duplicates (non-empty only) Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary") For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS) kukanCol = KUKAN_CODE_COLS(kukanIdx) kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value) If kukanCode <> "" Then If kukanCodes.Exists(kukanCode) Then kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E003", kukanLetter & rowNum) Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub Else kukanCodes.Add kukanCode, True End If End If Next kukanIdx ' Validate H, BB, BC columns Dim linkCellValue As String: linkCellValue = Me.Cells(3, "H").Value Dim ColBF As String: ColBF = "BF" Dim ColBG As String: ColBG = "BG" Dim valBF As String: valBF = Trim(Me.Cells(rowNum, ColBF).Value) Dim valBG As String: valBG = Trim(Me.Cells(rowNum, ColBG).Value) If linkCellValue = "1" Then ' If code = "1", BB and BC must be empty If valBF <> "" Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBF & rowNum) Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If If valBG <> "" Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBG & rowNum) Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ElseIf linkCellValue = "2" Then ' If code = "2", BB and BC must have value If valBF = "" Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBF & rowNum) Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If If valBG = "" Then Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBG & rowNum) Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If Me.Cells(rowNum, errorCol).ClearContents Exit Sub ErrHandler: lastErrorMsg = Err.Description End Sub ' Create teiki dropdown based on M2 cache Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long) ' Get kukanCode from KUKAN_CODE_COLS Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(idx) Dim kukanCode As String: kukanCode = Trim(Me.Cells(row, kukanCol).Value) ' Get kenshu from KUKAN_TICKET_COLS Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(row, KUKAN_TICKET_COLS(idx)).Value)) ' Get code2 from KUKAN_CODE2_COLS Dim code As String: code = GetCode(Trim(Me.Cells(row, KUKAN_CODE2_COLS(idx)).Value)) If kukanCode = "" Or kenshu = "" Or code = "" Then Exit Sub If Not kenshu = "1" Then Exit Sub Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx) Call BuildTeikiDropdown(row, kukanCode, kenshu, code, ColLetter(teikiColIndex)) End Sub Private Sub BuildTeikiDropdown(ByVal rowNum As Long, ByVal kukanCode As String, ByVal kenshu As String, ByVal code As String, ByVal targetCell As String) Dim M2Cache As Object: Set M2Cache = GetCache("M2") Dim kenshuDict As Object: Set kenshuDict = M2Cache(kukanCode) Dim codeDict As Object: Set codeDict = kenshuDict(kenshu) Dim teikiArray As Object: Set teikiArray = codeDict(code) If teikiArray Is Nothing Then Exit Sub If Not teikiArray.Exists("teikikikanNum") Then Exit Sub Dim teikiList As Variant: teikiList = teikiArray("teikikikanNum") If Not IsArray(teikiList) Then Exit Sub If UBound(teikiList) < LBound(teikiList) Then Exit Sub ' Build dropdown list Dim dropdownList As String: dropdownList = "" Dim i As Long For i = LBound(teikiList) To UBound(teikiList) Dim val As String: val = CStr(teikiList(i)) If val <> "" Then If dropdownList = "" Then dropdownList = val Else dropdownList = dropdownList & "," & val End If End If Next i If dropdownList <> "" Then With Me.Range(targetCell & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList .IgnoreBlank = True .InCellDropdown = True End With End If End Sub