vba/src/sh/tuk/module/Common_Functions.bas

Attribute VB_Name = "Common_Functions"
Option Explicit
' ============================================================
' Module Name: Module_Common
' Module Desc: Common utility functions for all modules
' Module Methods:
'   - GetLastDataRowInRange
'   - ClearDataRows
'   - ClearDataRow
' ============================================================

' Common Functions

' Get CSV header from specified row and columns
Function GetCSVHeader(ByVal ws As Worksheet) As Variant
    On Error GoTo ErrorHandler
    '
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)

    Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
    Dim headerRow As Long: headerRow = sheetConf("HeaderRow")

    Dim colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1
    Dim headerArr() As String
    ReDim headerArr(1 To 1, 1 To colCount)
    
    Dim i As Long
    Dim cellValue As String
    For i = 0 To colCount - 1
        Dim colIndex As Long
        colIndex = Columns(colLetters(i)).Column

        cellValue = Trim(ws.Cells(headerRow, colIndex).Value)
        cellValue = Replace(cellValue, vbLf, "")
        cellValue = Replace(cellValue, vbCr, "")
        cellValue = Replace(cellValue, vbCrLf, "")
        headerArr(1, i + 1) = cellValue
    Next i
    
    GetCSVHeader = headerArr
    Exit Function

ErrorHandler:
    Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
End Function

' Clean CSV field: add quote prefix for formula-like values
Function CleanCSVField(ByVal inputStr As String) As String
    Dim s As String
    s = Trim(inputStr)
    
    ' calcute
    If Len(s) > 0 Then
        Select Case Left(s, 1)
            Case "=", "+", "-", "@"
                CleanCSVField = "'" & s
                Exit Function
        End Select
    End If
    
    CleanCSVField = s
End Function

' Get last data row in specified column
Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
    GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
End Function

' Check if array contains value
Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
    Dim i As Long
    For i = 0 To UBound(arr)
        If arr(i) = value Then
            Contains = True
            Exit Function
        End If
    Next i

    Contains = False
End Function

' @return dict : key = keyCol, value = Array
' @param sheetName
' @param keyCol    
' @param valueCols     Array(4,5,6)
' @param startRow      default is 7
Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Object
    On Error GoTo ErrHandler

    ' --- validate ---
    If Trim(sheetName) = "" Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Sheet name cannot be empty."

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    If Not sheetConfDict.Exists(sheetName) Then
        Err.Raise ERR_CONFIG_NOT_FOUND, "LoadLookup", "Sheet not configured: " & sheetName
    End If
    
    ' --- obtain worksheet ---
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(sheetName)
    On Error GoTo ErrHandler
    If ws Is Nothing Then
        Err.Raise ERR_SHEET_MISSING, "LoadLookup", "Worksheet '" & sheetName & "' not found."
    End If
    
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
    Dim startRow As Long: startRow = sheetConf("StartRow")
    Dim keyCol As Long: keyCol = sheetConf("KeyCol")
    Dim valueCols As Variant: valueCols = sheetConf("ValueCols")

    Dim lastRow As Long
    If sheetName <> cacheName Then
        lastRow = ws.Cells(ws.Rows.Count, keyCol).End(xlUp).Row
    Else
        lastRow = GetLastDataRowInRange(ws)
    End If
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    If lastRow < startRow Then 
        Set LoadLookup = dict
        Exit Function
    End If

    Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
    If nValCols = 0 Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Value columns parameter is invalid."

    ' --- prepare col ---
    Dim minCol As Long: minCol = keyCol
    Dim maxCol As Long: maxCol = keyCol
    Dim i As Long
    For i = LBound(valueCols) To UBound(valueCols)
        If Not IsNumeric(valueCols(i)) Then
            Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column is not numeric at index " & i
        End If
        Dim colNum As Long: colNum = CLng(valueCols(i))
        If colNum < 1 Then
            Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column must be >= 1, got " & colNum
        End If
        If colNum < minCol Then minCol = colNum
        If colNum > maxCol Then maxCol = colNum
    Next i
    
    ' --- read ---
    Dim dataRange As Range
    Set dataRange = ws.Range(ws.Cells(startRow, minCol), ws.Cells(lastRow, maxCol))
    Dim data As Variant: data = dataRange.Value

    ' --- Ensure data is a 2D array ---
    If Not IsArray(data) Then
        ' Single cell case
        Dim temp As Variant
        ReDim temp(1 To 1, 1 To (maxCol - minCol + 1))
        temp(1, 1) = data
        data = temp
    End If
    
    ' --- build ---
    Dim keyOffset As Long: keyOffset = keyCol - minCol + 1
    Dim valOffsets() As Long: ReDim valOffsets(0 To nValCols - 1)
    For i = 0 To nValCols - 1
        valOffsets(i) = valueCols(LBound(valueCols) + i) - minCol + 1
    Next i
    
    ' --- write into  ---
    dict.CompareMode = vbTextCompare
    
    Dim r As Long
    For r = 1 To UBound(data, 1)
        Dim key As String: key = Trim(data(r, keyOffset))
        If key <> "" Then
            Dim vals() As String: ReDim vals(0 To nValCols - 1)
            Dim j As Long
            For j = 0 To nValCols - 1
                vals(j) = Trim(data(r, valOffsets(j)))
            Next j
            dict(key) = vals
        End If
    Next r
    
    Set LoadLookup = dict
    Exit Function

ErrHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Function

' Get last data row in specified column
Function GetLastDataRowInRange(ws As Worksheet) As Long

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()

    If sheetConfDict.Exists(ws.CodeName) Then
        Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)

        Dim startCol As Long, endCol As Long, startRow As Long
        On Error GoTo InvalidColumn
        startCol = ws.Range(sheetConf("StartCol") & "1").Column
        endCol = ws.Range(sheetConf("EndCol") & "1").Column
        startRow = sheetConf("StartRow")
        On Error GoTo 0

        ' --- query max row ---
        Dim colIndex As Long, lastRow As Long, maxRow As Long
        
        maxRow = startRow - 1
        For colIndex = startCol To endCol
            lastRow = ws.Cells(ws.Rows.Count, colIndex).End(xlUp).Row
            If lastRow > maxRow Then maxRow = lastRow
        Next colIndex
        
        GetLastDataRowInRange = maxRow
    Else
        Err.Raise ERR_CONFIG_NOT_FOUND, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName
    End If
    Exit Function

InvalidColumn:
    Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
End Function

'Clear single row data and format
Sub ClearDataRow(ByVal ws As Worksheet, ByVal rowNum As Long)
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    If Not sheetConfDict.Exists(ws.CodeName) Then
        Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRow", "Sheet not configured: " & ws.CodeName
    End If

    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
    
    Dim startRow As Long: startRow = sheetConf("StartRow")
    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.ClearContents
    clearRange.Interior.Color = vbWhite
    clearRange.Validation.Delete

    Dim errorRange As Range: Set errorRange = ws.Range(ws.Cells(rowNum, errorCol), ws.Cells(rowNum, errorCol))
    errorRange.ClearContents
    errorRange.Interior.Color = vbWhite
    errorRange.Validation.Delete
End Sub

'Clear all data rows from startRow to lastDataRow
Sub ClearDataRows(ByVal ws As Worksheet)
    ' Clear data and format from startRow to lastDataRow
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    ' 
    If Not sheetConfDict.Exists(ws.CodeName) Then
        Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRows", "Sheet not configured: " & ws.CodeName
    End If

    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)

    Dim startRow As Long: startRow = sheetConf("StartRow")
    Dim startCol As String: startCol = sheetConf("StartCol")
    Dim endCol As String: endCol = sheetConf("EndCol")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")

    Application.EnableEvents = False
    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
    If lastDataRow >= startRow Then
        Dim clearRange As Range
        Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
        clearRange.ClearContents
        clearRange.Interior.Color = vbWhite

        If errorCol <> "" Then
          Dim clearErrorRange As Range
          Set clearErrorRange = ws.Range(ws.Cells(startRow, ws.Range(errorCol & "1").Column), ws.Cells(lastDataRow, ws.Range(errorCol & "1").Column))
          clearErrorRange.ClearContents
          clearErrorRange.Interior.Color = vbWhite
        End If
    End If
    
    ' Clear formats below lastDataRow (including dropdowns)
    Application.EnableEvents = True
    Call ClearFormatsBelowLastDataRow(ws)
End Sub

'Clear formats below lastDataRow
Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
    On Error GoTo ErrorHandler
    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
    
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
    
    Dim startCol As Long, endCol As Long
    startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
    endCol = ws.Range(sheetConf("EndCol") & "1").Column

    If lastRow >= ws.Rows.Count Then Exit Sub

    Dim clearRange As Range
    Set clearRange = ws.Range( _
        ws.Cells(lastRow + 1, startCol), _
        ws.Cells(ws.Rows.Count, endCol) _
    )

    Application.EnableEvents = False
    clearRange.ClearContents
    clearRange.Interior.Color = vbWhite
    clearRange.Validation.Delete
    Application.EnableEvents = True

ErrorHandler:
    Application.EnableEvents = True
End Sub

' Check if text starts with prefix
Function StartsWith(text As String, prefix As String) As Boolean
    If Len(text) < Len(prefix) Then
        StartsWith = False
    Else
        StartsWith = (Left(text, Len(prefix)) = prefix)
    End If
End Function

' Make select format: code:value
Function MakeSelect(ByVal code As String, ByVal value As String) As String
    MakeSelect = Trim(code) & ":" & Trim(value)
End Function

' Get left part of MakeSelect format (e.g., "1:JR" -> "1")
Function GetCode(ByVal text As String) As String
    Dim pos As Long: pos = InStr(text, ":")
    If pos > 0 Then
        GetCode = Left(text, pos - 1)
    Else
        GetCode = text
    End If
End Function

' ============================================================
' Format date input: YYYYMMDD or YYMMDD -> YYYY-MM-DD
' ============================================================
Public Function FormatDateInput(ByVal inputStr As String) As String
    Dim s As String: s = Trim(inputStr)
    If s = "" Then Exit Function
    
    ' Only process pure digit strings
    If Not IsNumeric(s) Then
        FormatDateInput = inputStr
        Exit Function
    End If
    
    Dim yearPart As String, monthPart As String, dayPart As String
    Dim dateStr As String
    
    If Len(s) = 8 Then
        ' YYYYMMDD format
        yearPart = Left(s, 4)
        monthPart = Mid(s, 5, 2)
        dayPart = Right(s, 2)
    ElseIf Len(s) = 6 Then
        ' YYMMDD format - add 20 prefix
        yearPart = "20" & Left(s, 2)
        monthPart = Mid(s, 3, 2)
        dayPart = Right(s, 2)
    Else
        FormatDateInput = inputStr
        Exit Function
    End If
    
    ' Build date string and validate
    dateStr = yearPart & "-" & monthPart & "-" & dayPart
    
    If IsDate(dateStr) Then
        FormatDateInput = dateStr
    Else
        FormatDateInput = inputStr
    End If
End Function

'Check header edit protection
Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
    Dim filterRow As Long: filterRow = sheetConf("FilterRow")

    ' Check rows 1 to filterRow cannot be edited
    Dim r As Long
    For r = Target.Row To Target.Row + Target.Rows.Count - 1
        If r >= 1 And r <= filterRow Then
            Application.EnableEvents = False
            MsgBox "Cannot edit rows 1 to " & filterRow & ".", vbExclamation
            Application.Undo
            Application.EnableEvents = True

            CheckHeaderEdit = True
            Exit Function
        End If
    Next r

    ' filterRow color is not equals to filterRow + 1
    If Target.Row = filterRow + 1 Then
        Dim firstCell As Range: Set firstCell = Target.Cells(1, 1)
        Dim colIndex As Long: colIndex = firstCell.Column
        Dim refCell As Range: Set refCell = ws.Cells(filterRow, colIndex)
        If firstCell.Interior.Color = refCell.Interior.Color Then
            Application.EnableEvents = False
            MsgBox "Cannot autoFill from filterRow.", vbExclamation
            Application.Undo
            Application.EnableEvents = True
            
            CheckHeaderEdit = True
            Exit Function
        End If
    End If

    CheckHeaderEdit = False
End Function

'Get error message by code
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
    Dim errorList As Object: Set errorList = GetCache("errorList")
    Dim errorMessage As String
    If errorList.Exists(errorCode) Then
        errorMessage = Replace(errorList(errorCode)(0), "{0}", param0)
        errorMessage = Replace(errorMessage, "{1}", param1)
        errorMessage = MakeSelect(errorCode, errorMessage)
    End If
    GetErrorMsg = errorMessage
End Function

'Convert column number to letter
Function ColLetter(colNum As Long) As String
    ColLetter = Split(Cells(1, colNum).Address, "$")(1)
End Function

'Check required field is not empty
Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If checkValue = "" Then
        Dim letter As String: letter = ColLetter(colNum)
        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", letter & rowNum)
        ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        CheckRequired = False
        Exit Function
    End If
    CheckRequired = True
End Function

'Check character length
Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) <> charLength Then
        Dim letter As String: letter = ColLetter(colNum)
        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E006", letter & rowNum, charLength)
        ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        CheckChar = False
        Exit Function
    End If
    CheckChar = True
End Function

'Check alphanumeric characters
Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
    Dim i As Long
    Dim ch As String
    For i = 1 To charLength
        ch = Mid(checkValue, 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, errorCol).Value = GetErrorMsg("E005", letter & rowNum)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            CheckAlphanumeric = False
            Exit Function
        End If
    Next i

    CheckAlphanumeric = True
End Function

'Check varchar length overflow
Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > varcharLength Then
        Dim letter As String: letter = ColLetter(colNum)
        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E007", letter & rowNum)
        ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        CheckVarcharOver = False
        Exit Function
    End If
    CheckVarcharOver = True
End Function

'Check number length overflow
Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > numberLength Then
        Dim letter As String: letter = ColLetter(colNum)
        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E014", letter & rowNum, numberLength)
        ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        CheckNumberOver = False
        Exit Function
    End If
    CheckNumberOver = True
End Function

'Check value is 0 or 1
Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
    If checkValue <> "" Then
        If Len(checkValue) <> 1 Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            Check01 = False
            Exit Function
        End If
        If checkValue <> "0" And checkValue <> "1" Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E008", letter & rowNum)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            Check01 = False
            Exit Function
        End If
    End If
    Check01 = True
End Function

'Check value is 1 or 2
Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
    If checkValue <> "" Then
        If Len(checkValue) <> 1 Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", letter & rowNum)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            Check12 = False
            Exit Function
        End If
        If checkValue <> "1" And checkValue <> "2" Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E009", letter & rowNum)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            Check12 = False
            Exit Function
        End If
    End If
    Check12 = True
End Function

'Check duplicate value in column
Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
    Dim i As Long
    
    For i = 7 To rowNum - 1
        If Trim(ws.Cells(i, colNum).Value) = checkValue Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E010", letter & rowNum, checkValue)
            ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
            CheckDuplicate = False
            Exit Function
        End If
    Next i
    
    CheckDuplicate = True
End Function

'Check numeric value
Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
    
    If checkValue = "" Then
        CheckNumber = True
        Exit Function
    End If

    If Not IsNumeric(checkValue) Then
        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", letter & rowNum)
        ws.Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
        CheckNumber = False
        Exit Function
    End If
    
    CheckNumber = True
End Function