' ============================================================ ' Module Name: Tukin_C1 ' Module Desc: Commuter allowance editing sheet (no CSV import) ' Module Methods: ' - Tukin_ValidateRow ' - FillTransportFromM1KukanD ' - FillDepartureFromM1KukanD ' - FillArrivalFromM1KukanD ' - FillKukanFromM1 ' - FillKanshuFromM2 ' - FillCodeFromM2 ' - CreateAddress1Dropdown ' - FillZ1Dropdown ' ============================================================ ' ====== (Tukin_C1) ======= ' Commuter allowance editing sheet ' No CSV import - direct editing only ' ============================================================ ' Column arrays for 4 kukan sections ' ============================================================ Private Function KUKAN_CODE_COLS() As Variant KUKAN_CODE_COLS = Array(19, 26, 33, 40) ' S, Z, AG, AN End Function Private Function KUKAN_TRANSPORT_COLS() As Variant KUKAN_TRANSPORT_COLS = Array(20, 27, 34, 41) ' T, AA, AH, AO End Function Private Function KUKAN_STATION_COLS() As Variant KUKAN_STATION_COLS = Array(21, 28, 35, 42) ' U, AB, AI, AP End Function Private Function KUKAN_ARRIVAL_COLS() As Variant KUKAN_ARRIVAL_COLS = Array(22, 29, 36, 43) ' V, AC, AJ, AQ End Function Private Function KUKAN_TICKET_COLS() As Variant KUKAN_TICKET_COLS = Array(23, 30, 37, 44) ' W, AD, AK, AR End Function Private Function KUKAN_CODE2_COLS() As Variant KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS End Function Private Function KUKAN_START_DAY_COLS() As Variant KUKAN_START_DAY_COLS = Array(25, 32, 39, 46) ' Y, AF, AM, AT End Function Private Function DATE_COLS() As Variant DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 51, 54) ' D, E, F, Y, AF, AM, AT, AY, BB 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 watchArea As Range With Me Set watchArea = Union( _ .Columns("C"), _ .Columns("D"), _ .Columns("E"), _ .Columns("F"), _ .Columns("G"), _ .Columns("I"), _ .Columns("S:W"), _ .Columns("Z:AD"), _ .Columns("AG:AK"), _ .Columns("AN:AR"), _ .Columns("BB") _ ) 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 Dim idx As Long Application.EnableEvents = False On Error GoTo Finally ' === 3. rebuild dropdown list === Call RebuildDropdownsForTarget(Target) ' === Column C changes === If Target.Column = 3 Then Dim cell As Range For Each cell In Target If Trim(cell.Value) = "" Then Call ClearRowData(cell.Row) Else Call CreateAddress1Dropdown(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 = GetZ4Cache() 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 CreateAddress2Dropdown(cellI.Row) 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, AA, AH, AO) === 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, AB, AI, AP) === 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, AC, AJ, AQ) === 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, Z, AG, AN) === 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, AD, AK, AR) === 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 Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col) Next End If Finally: Application.EnableEvents = True ' End Sub Private Sub RebuildDropdownsForTarget(ByVal Target As Range) If Target Is Nothing Then Exit Sub Dim cell As Range Dim processedRows As Object Set processedRows = CreateObject("Scripting.Dictionary") For Each cell In Target Dim r As Long r = cell.Row If Not processedRows.Exists(r) Then processedRows(r) = True Dim colLetter As String colLetter = Split(Me.Cells(1, cell.Column).Address(True, False), "$")(0) Dim dropdowns As Variant dropdowns = Array( _ Array("T", "BuildTransportList"), _ Array("AA", "BuildTransportList"), _ Array("AH", "BuildTransportList"), _ Array("AO", "BuildTransportList"), _ Array("G", "BuildTodokeList"), _ Array("M", "BuildOufukuList"), _ Array("N", "BuildKoutaiList"), _ Array("AU", "BuildKetteiList"), _ Array("AW", "BuildHigaitouList"), _ Array("AX", "BuildMonthAmountKbnList"), _ Array("BC", "BuildKanshokuList") _ ) Dim i As Long For i = LBound(dropdowns) To UBound(dropdowns) If colLetter <> dropdowns(i)(0) Then With Me.Cells(r, dropdowns(i)(0)).Validation .Delete .Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1)) .IgnoreBlank = True .InCellDropdown = True End With End If Next i End If NextCell: Next cell 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 = GetM1Cache() 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 Private Sub CreateAddress1Dropdown(ByVal rowNum As Long) Dim o1Cache As Object: Set o1Cache = GetO1Cache() Dim empNo As String empNo = Trim(Me.Cells(rowNum, 3).Value) If empNo = "" Then Exit Sub ' Build dropdown list from O1 cache: get all E values for the C Dim dropdownList As String If o1Cache.Exists(empNo) Then Dim innerDict As Object Set innerDict = o1Cache(empNo) 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 ' triggered by address1 select O1 cache Private Sub CreateAddress2Dropdown(ByVal rowNum As Long) Dim o1Cache As Object: Set o1Cache = GetO1Cache() Dim empNo As String empNo = Trim(Me.Cells(rowNum, 3).Value) If empNo = "" Then Me.Range("J" & rowNum).Validation.Delete Me.Range("J" & rowNum).Value = "" Exit Sub End If Dim addr1 As String addr1 = Trim(Me.Cells(rowNum, 9).Value) Me.Range("J" & rowNum).Value = "" If addr1 = "" Then Me.Range("J" & rowNum).Validation.Delete Exit Sub End If ' Build dropdown list from O1 cache Dim dropdownList As String If o1Cache.Exists(empNo) Then Dim innerDict As Object Set innerDict = o1Cache(empNo) If innerDict.Exists(addr1) Then Dim addr2Dict As Object Set addr2Dict = innerDict(addr1) 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 ' 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 = GetM1KukanDCache() 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 = GetKenshuList() Dim m2Cache As Object: Set m2Cache = GetM2Cache() 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 = GetM1KukanDCache() 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 = GetM1Cache() 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 CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) Dim m2Cache As Object: Set m2Cache = GetM2Cache() 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 If dropdownList = "" Then dropdownList = MakeSelect(code, innermostDict(code)) Else dropdownList = dropdownList & "," & code 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 ' 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(ws.CodeName) Dim startCol As String: startCol = sheetConf("StartCol") Dim endCol As String: endCol = sheetConf("EndCol") Dim errorCol As String: errorCol = sheetConf("ErrorCol") Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents Me.Cells(rowNum, errorCol).ClearContents Dim clearValidationCols As Variant clearValidationCols = Array("I", "J", "U", "V", "X", "AB", "AC", "AE", "AI", "AJ", "AL", "AP", "AQ", "AS") Dim col As Variant For Each col In clearValidationCols Me.Range(col & rowNum).Validation.Delete Next col End Sub ' Validation logic 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 ' Required columns: C-G, K-N, AW Dim requiredCols As Variant requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "AW") Dim col As Variant For Each col In requiredCols If Trim(Me.Range(col & rowNum).Value & "") = "" Then Me.Cells(rowNum, errorCol).Value = col & " column is required" 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 = letter & " column is invalid" 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 = col & " column is invalid" 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 = GetZ4Cache() Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value)) If Not z4Cache.Exists(todokeCde) Then Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid" 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 = GetO1Cache() 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 = GetOufukuList() Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value)) If Not oufukuList.Exists(oufukuCde) Then Me.Cells(rowNum, errorCol).Value = ColM & " column is invalid" 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 = GetKoutaiList() 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 = GetM1Cache() Dim m2Cache As Object: Set m2Cache = GetM2Cache() 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 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 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 Me.Cells(rowNum, errorCol).ClearContents End Sub