' CSV Header Constants 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 Sub ImportMasterDetailData() Dim filePath As String Dim fileDialog As FileDialog Dim wsTarget As Worksheet Dim stream As Object Dim textContent As String Dim lines As Variant Dim i As Long Dim dataArray As Variant Dim code As String Dim lastRow As Long Dim r As Long ' Target this worksheet Set wsTarget = Me ' === Step 1: Select CSV file === Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) With fileDialog .Filters.Clear .Filters.Add "CSV Files", "*.csv" .AllowMultiSelect = False If .Show <> -1 Then Exit Sub filePath = .SelectedItems(1) End With ' === Step 2: Read CSV with Shift-JIS === Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 .Charset = "shift_jis" .Open .LoadFromFile filePath textContent = .ReadText .Close End With lines = Split(textContent, vbLf) ' === Validate data rows - must have exactly 7 columns === Dim lineNum As Long For lineNum = 0 To UBound(lines) If Trim(lines(lineNum)) <> "" Then dataArray = Split(lines(lineNum), ",") If UBound(dataArray) + 1 <> 7 Then MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected 7.", vbExclamation Exit Sub End If End If Next lineNum ' === Clear all data rows before import === lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row If lastRow >= 7 Then wsTarget.Range("A7:P" & lastRow).ClearContents End If If UBound(lines) < 1 Then MsgBox "No data in CSV.", vbExclamation Exit Sub End If ' === Step 3: Collect CSV codes and data === Dim csvData As Object Set csvData = CreateObject("Scripting.Dictionary") For i = 0 To UBound(lines) If Trim(lines(i)) = "" Then GoTo NextCsvLine dataArray = Split(lines(i), ",") If UBound(dataArray) >= 0 Then code = CleanCSVField(CStr(dataArray(0))) If code <> "" Then ' Use unique key: code + "_" + row index to avoid duplicate key error csvData.Add code & "_" & i, dataArray End If End If NextCsvLine: Next i If csvData.Count = 0 Then MsgBox "No valid code found.", vbExclamation Exit Sub End If ' === Step 6: Write CSV data to next available row === writeRow = 7 For i = 0 To UBound(lines) If Trim(lines(i)) = "" Then GoTo NextLine dataArray = Split(lines(i), ",") ' CSV col 1 -> C column code = CleanCSVField(CStr(dataArray(0))) wsTarget.Cells(writeRow, 3).Value = code ' CSV col 2-11 -> G-P column If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(1))) If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(2))) If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(3))) If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(4))) If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(5))) If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(6))) If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(7))) If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(8))) If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 17).Value = CleanCSVField(CStr(dataArray(9))) If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 18).Value = CleanCSVField(CStr(dataArray(10))) ' Auto-fill D, E columns Call FillFromKukanMaster(wsTarget, writeRow, False) ' G column has value → trigger F dropdown writeRow = writeRow + 1 NextLine: Next i MsgBox writeRow - 7 & " rows imported.", vbInformation End Sub Function CleanCSVField(ByVal field As Variant) As String If IsEmpty(field) Or IsNull(field) Then CleanCSVField = "" Exit Function End If Dim result As String result = Trim(CStr(field)) If Len(result) >= 2 Then If Left(result, 1) = """" And Right(result, 1) = """" Then result = Mid(result, 2, Len(result) - 2) result = Replace(result, """""", """") End If End If CleanCSVField = result End Function Sub validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long) ' Check C column - must be 3-digit alphanumeric, required Dim cValue As String cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then ws.Cells(rowNum, 2).Value = "C column is required" Exit Sub End If If Len(cValue) <> 3 Then ws.Cells(rowNum, 2).Value = "C column must be 3 characters" Exit Sub End If Dim i As Long Dim ch As String For i = 1 To 3 ch = Mid(cValue, i, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" Exit Sub End If Next i ' Check D column - must be within 80 full-width characters, required Dim dValue As String dValue = Trim(ws.Cells(rowNum, 4).Value) If dValue = "" Then ws.Cells(rowNum, 2).Value = "D column is required" Exit Sub End If If Len(dValue) > 80 Then ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" Exit Sub End If ' Check E column - must be within 80 full-width characters, required Dim eValue As String eValue = Trim(ws.Cells(rowNum, 5).Value) If eValue = "" Then ws.Cells(rowNum, 2).Value = "E column is required" Exit Sub End If If Len(eValue) > 80 Then ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" Exit Sub End If ' Check F column - must be within 80 full-width characters, optional Dim fValue As String fValue = Trim(ws.Cells(rowNum, 6).Value) If fValue <> "" And Len(fValue) > 80 Then ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" Exit Sub End If ' Check G column - must be within 80 full-width characters, optional Dim gValue As String gValue = Trim(ws.Cells(rowNum, 7).Value) If gValue <> "" And Len(gValue) > 80 Then ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" Exit Sub End If ' Check I column - must be within 80 full-width characters, optional Dim iValue As String iValue = Trim(ws.Cells(rowNum, 9).Value) If iValue <> "" And Len(iValue) > 80 Then ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" Exit Sub End If ' Check H column - 1 digit, 0 or 1, optional Dim hValue As String hValue = Trim(ws.Cells(rowNum, 8).Value) If hValue <> "" Then If Len(hValue) <> 1 Then ws.Cells(rowNum, 2).Value = "H column must be 1 digit" Exit Sub End If If hValue <> "0" And hValue <> "1" Then ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" Exit Sub End If End If ' Validation passed ws.Cells(rowNum, 2).ClearContents End Sub ' Button macro (Validate selected row) Sub validateDetailDataButton() Dim ws As Worksheet Dim lastRow As Long Dim r As Long Dim errorCount As Long Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row If lastRow < 7 Then MsgBox "No data found.", vbExclamation Exit Sub End If errorCount = 0 For r = 7 To lastRow Call validateDetailData(ws, r) If Trim(ws.Cells(r, 2).Value) <> "" Then errorCount = errorCount + 1 End If Next r MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation End Sub Sub ExportMasterDetailData() Dim ws As Worksheet Set ws = ActiveSheet Dim lastDataRow As Long lastDataRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row If lastDataRow < 7 Then MsgBox "No data rows to output.", vbExclamation Exit Sub End If Dim savePath As String savePath = Application.GetSaveAsFilename( _ FileFilter:="CSV Files (*.csv), *.csv", _ Title:="Save CSV") If savePath = "False" Then Exit Sub If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then savePath = savePath & ".csv" End If ' Build header from row 5 (columns C, G-P) Dim csvContent As String csvContent = Trim(ws.Cells(5, 3).Value) Dim j As Long For j = 7 To 16 csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value) Next j csvContent = csvContent & vbLf ' Row counter Dim rowCount As Long rowCount = 0 ' Data: C,G,H,I,J,K,L,M,N,O,P (skip D,E,F) Dim r As Long For r = 7 To lastDataRow If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then rowCount = rowCount + 1 ' CSV col1 -> C column csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value) ' CSV col2-11 -> I-R column For j = 9 To 18 csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value) Next j csvContent = csvContent & vbLf End If Next r ' Trim trailing empty lines Do While Right(csvContent, 1) = vbLf csvContent = Left(csvContent, Len(csvContent) - 1) Loop ' Write file Dim stream As Object Set stream = CreateObject("ADODB.Stream") stream.Type = 2 stream.Charset = "shift_jis" stream.Open stream.WriteText csvContent, 1 stream.SaveToFile savePath, 2 stream.Close MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation End Sub