Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
buianhtuan.cdt
in reply to: Anonymous

'Setting Sheetname
    Public Const DBSheetname As String = "ƒf[ƒ^ƒx[ƒX"
    Public Const StaffManagerSheetname As String = "lˆõŠÇ—"
    Public Const ProjectSheetname As String = "ˆÄŒŠÇ—"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function HCF4079_DefineRowEndNo(WS As Worksheet, EndRow As Integer, ColumnNo As Integer)
    EndRow = WS.Cells(Rows.Count, ColumnNo).End(xlUp).Row
End Function
Function Func29ConvertColumnLetterToNumber(ColumnLetter As String) As Integer
' Function chuyen ma so cot tu letter sang number
    'Convert To Column Number
    Dim ColumnNumber As Long
    ColumnNumber = Range(ColumnLetter & 1).Column
    Func29ConvertColumnLetterToNumber = ColumnNumber
End Function
Function HCF4086_IsInArr2Chieu_NumberOrString(ListArr As Variant, ListColumnNo As Integer, NeedCheckValue As Variant) As Boolean
    Dim CompareValue As Variant
    For i = LBound(ListArr) To UBound(ListArr)
        CompareValue = ListArr(i, ListColumnNo)
        If CompareValue = NeedCheckValue Then
            HCF4086_IsInArr2Chieu_NumberOrString = True
            Exit Function
        End If
    Next
End Function
Function HCF4060_GetStringMiddle2Delimited(Str As String, Delimited1 As String, Delimited2 As String) As String
    Dim Result As String
    Dim Delimited1Position As Integer
    Dim Delimited2Position As Integer
    Delimited1Position = InStr(Str, Delimited1)
    Delimited2Position = InStr(Str, Delimited2)
    If Delimited1Position * Delimited2Position = 0 Then Exit Function
    Result = Mid(Str, Delimited1Position + 1, Delimited2Position - Delimited1Position - 1)
    HCF4060_GetStringMiddle2Delimited = Result
End Function
Function HCF4117_VlookupInArr2Dimension_NumberOrString(ListArr As Variant, CheckColumnNo As Integer, ResultColumnNo As Integer, CheckValue As Variant) As Variant
    Dim CompareValue As Variant
    Dim StrCheckValue As String: StrCheckValue = CStr(CheckValue)
    Dim Result As Variant
    If HCF4116_IsTwoDimensionalArray(ListArr) = False Then
        HCF4117_VlookupInArr2Dimension_NumberOrString = False
        Exit Function
    End If
    For i = LBound(ListArr) To UBound(ListArr)
        CompareValue = ListArr(i, CheckColumnNo)
        CompareValue = CStr(CompareValue)
        If CompareValue = StrCheckValue Then
            Result = ListArr(i, ResultColumnNo)
        End If
    Next
    If VarType(Result) = vbEmpty Then Result = False
    HCF4117_VlookupInArr2Dimension_NumberOrString = Result
End Function
Function HCF4047_Convert2Integer(InputValue As Variant) As Variant
    Dim OutputValue As Variant
    On Error Resume Next
    OutputValue = CInt(InputValue)
    If Err Then
        OutputValue = False
    Else
        OutputValue = CInt(InputValue)
        If OutputValue - InputValue <> 0 Then OutputValue = False
    End If
    HCF4047_Convert2Integer = OutputValue
End Function
Function HCF4048_Convert2Double(InputValue As Variant) As Variant
    Dim OutputValue As Variant
    On Error Resume Next
    OutputValue = CDbl(InputValue)
    If Err Then
        OutputValue = False
    Else
        OutputValue = CDbl(InputValue)
    End If
    HCF4048_Convert2Double = OutputValue
End Function
Function HCF4116_IsTwoDimensionalArray(Arr As Variant) As Boolean
    Dim i As Integer
    On Error GoTo ExitFunction
    i = UBound(Arr, 2)
    HCF4116_IsTwoDimensionalArray = True
ExitFunction:
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function TBFH100_GetFilePath(FileFilter As String, Title As String, MultiSelectMode As Boolean) As Variant
    Dim fnameList As Variant
    fnameList = Application.GetOpenFilename(FileFilter, , Title, , MultiSelectMode)
    If (vbBoolean = VarType(fnameList)) Then
        MsgBox "No files selected"
        TBFH100_GetFilePath = False
    Else
        TBFH100_GetFilePath = fnameList
    End If
End Function
Function TBFH102_CrearArrFromRange(WS As Worksheet, MainColumnLetter As String, ColumnFromLetter As String, ColumnToLetter As String, RowFrom As Integer) As Variant
' Tao mang 2 chieu tu Range
    Dim Arr() As Variant
'Define Column no
    Dim ColumnFromNo As Integer
    Dim ColumnToNo As Integer
    Dim MainColumnNo As Integer
    ColumnFromNo = Func29ConvertColumnLetterToNumber(ColumnFromLetter)
    ColumnToNo = Func29ConvertColumnLetterToNumber(ColumnToLetter)
    MainColumnNo = Func29ConvertColumnLetterToNumber(MainColumnLetter)
'Define EndRow no, neu k co du lieu thi thoat
    Dim EndRow As Integer
    EndRow = WS.Cells(Rows.Count, MainColumnNo).End(xlUp).Row
    If EndRow < RowFrom Then Exit Function
'Define Arr TotalColumn va TotalRow
    Dim ArrTotalColumn As Integer
    Dim ArrTotalRow As Integer
    Dim ArrColumn As Integer
    Dim ArrRow As Integer
    Dim TmpValue As String
    ArrTotalColumn = ColumnToNo - ColumnFromNo
    ArrTotalRow = EndRow - RowFrom
    ReDim Arr(0 To ArrTotalRow, 0 To ArrTotalColumn)
    For i = RowFrom To EndRow
        ArrRow = i - RowFrom
        For k = ColumnFromNo To ColumnToNo
            ArrColumn = k - ColumnFromNo
            TmpValue = WS.Cells(i, k).Value
            Arr(ArrRow, ArrColumn) = TmpValue
        Next
    Next
TBFH102_CrearArrFromRange = Arr
End Function
Function TBFH103_Call_CreatStaffManagerArr(StaffManagerArr As Variant)
    Dim StaffWS As Worksheet: Set StaffWS = ThisWorkbook.Sheets(StaffManagerSheetname)
    StaffManagerArr = TBFH102_CrearArrFromRange(StaffWS, "C", "A", "G", 2)
End Function

Function TBFH104_DefineMonthFromExcelFilePath(ExcelFilePath As String) As String
    Dim MonthValue As String
    Dim Delimited1 As String: Delimited1 = "."
    Dim Delimited2 As String: Delimited2 = "ŒŽ"
    MonthValue = HCF4060_GetStringMiddle2Delimited(ExcelFilePath, Delimited1, Delimited2)
    TBFH104_DefineMonthFromExcelFilePath = MonthValue
End Function

Function TBFH105_GetStaffInformationFromPCNo_StaffID_StaffName(LookupValue As String, FromPC_FromID_FromName_Mode As String, PC_ID_SName_GName_GNo_TeamName_TeamNo_Mode As String) As String
'Creat StaffManagerArr
    Dim StaffManagerArr As Variant
    Call TBFH103_Call_CreatStaffManagerArr(StaffManagerArr)
'Define CheckColumnNo
    Dim CheckColumnNo As Integer
    Select Case FromPC_FromID_FromName_Mode
        Case "FromPC"
            CheckColumnNo = 0
        Case "FromID"
            CheckColumnNo = 1
        Case "FromName"
            CheckColumnNo = 2
    End Select
'Define ResultColumnNo
    Dim ResultColumnNo As Integer
    Select Case PC_ID_SName_GName_GNo_TeamName_TeamNo_Mode
        Case "PC"
            ResultColumnNo = 0
        Case "ID"
            ResultColumnNo = 1
        Case "SName"
            ResultColumnNo = 2
        Case "GName"
            ResultColumnNo = 3
        Case "GNo"
            ResultColumnNo = 4
        Case "TeamName"
            ResultColumnNo = 5
        Case "TeamNo"
            ResultColumnNo = 6
        Case Else
            Exit Function
    End Select
'Result
    Dim Result As Variant
    Result = HCF4117_VlookupInArr2Dimension_NumberOrString(StaffManagerArr, CheckColumnNo, ResultColumnNo, LookupValue)
    If VarType(Result) <> vbBoolean Then
        TBFH105_GetStaffInformationFromPCNo_StaffID_StaffName = Result
    End If
End Function
Function TBFH106_GetProjectInformationFromProjectName(ProjectName As String, ProjectCode_CustomerName_GNo_TNo_1to12_Mode) As String
'Creat ProjectManagerArr
    Dim ProjectManagerArr As Variant
    Call TBFH107_Call_CreatProjectManagerArr(ProjectManagerArr)
'Define CheckColumnNo
    Dim CheckColumnNo As Integer: CheckColumnNo = 2
'Define ResultColumnNo
    Dim ResultColumnNo As Integer
    Dim Convert2Integer As Variant
    Select Case ProjectCode_CustomerName_GNo_TNo_1to12_Mode
        Case "ProjectCode"
            ResultColumnNo = 0
        Case "CustomerName"
            ResultColumnNo = 1
        Case "GNo"
            ResultColumnNo = 3
        Case "TNo"
            ResultColumnNo = 4
        Case Else
            Convert2Integer = HCF4047_Convert2Integer(ProjectCode_CustomerName_GNo_TNo_1to12_Mode)
            If VarType(Convert2Integer) = vbBoolean Then
                Exit Function
            Else
                If Convert2Integer < 1 Or Convert2Integer > 12 Then
                    Exit Function
                Else
                    ResultColumnNo = Convert2Integer + 4
                End If
            End If
    End Select
'Result
    Dim Result As Variant
    Result = HCF4117_VlookupInArr2Dimension_NumberOrString(ProjectManagerArr, CheckColumnNo, ResultColumnNo, ProjectName)
    If VarType(Result) <> vbBoolean Then
        TBFH106_GetProjectInformationFromProjectName = Result
    End If
End Function
Function TBFH107_Call_CreatProjectManagerArr(ProjectManagerArr As Variant)
    Dim ProjectWS As Worksheet: Set ProjectWS = ThisWorkbook.Sheets(ProjectSheetname)
    ProjectManagerArr = TBFH102_CrearArrFromRange(ProjectWS, "C", "A", "Q", 2)
End Function
Function TBFH108_CheckRangeIsEmpty(WS As Worksheet, RowNo As Integer, ColumnFrom As Integer, ColumnTo As Integer) As Boolean
    Dim RangeValue As String
    Dim EachValue As String
    For i = ColumnFrom To ColumnTo
        EachValue = WS.Cells(RowNo, i).Value
        RangeValue = RangeValue & EachValue
    Next
    If RangeValue = "" Then
        TBFH108_CheckRangeIsEmpty = True
    Else
        TBFH108_CheckRangeIsEmpty = False
    End If
End Function
Function TBFH109_Call_LockUnLockRange(WS As Worksheet, RowFrom As Integer, RowTo As Integer, ColumnLetterFrom As String, ColumnLetterTo As String, LockMode As Boolean)
    Dim LockRange As Range
    Set LockRange = WS.Range(ColumnLetterFrom & RowFrom & ":" & ColumnLetterTo & RowTo)
'unlock all
    WS.Unprotect
    WS.Cells.Locked = False
    LockRange.Locked = LockMode
    WS.Protect
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Sub TBS100_GetOldDataIntoDatabase()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
'Setting
    Dim ToWB As Workbook: Set ToWB = ThisWorkbook
    Dim ToWS As Worksheet: Set ToWS = ToWB.Sheets(DBSheetname)
    Dim StaffWS As Worksheet: Set StaffWS = ToWB.Sheets(StaffManagerSheetname)
'Creat StaffManagerArr
    Dim StaffManagerArr As Variant
    Call TBFH103_Call_CreatStaffManagerArr(StaffManagerArr)
'Get Files
    Dim GetFiles As Variant
    Dim FileFilter As String: FileFilter = "Excel Files (*.xls),*.xls"
    Dim Title As String: Title = "Choose Excel files"
    Dim MultiSelectMode As Boolean: MultiSelectMode = True
    GetFiles = TBFH100_GetFilePath(FileFilter, Title, True)
    If VarType(GetFiles) = vbBoolean Then GoTo GotoExitSub
    
    Dim FromWSData() As Variant
    Dim FromWSDataRowNo As Integer
For i = LBound(GetFiles) To UBound(GetFiles)
'Open File
    Dim FromWSEachRowData(1 To 40) As String
    Dim FromWBPath As String: FromWBPath = GetFiles(i)
    Dim FromWB As Workbook: Set FromWB = Workbooks.Open(FromWBPath, , True)
    Dim FromWS As Worksheet
    Dim FromSheetname As String
    Dim FromEndRow As Integer
    Dim IsStaffName As Boolean
    Dim MonthValue As String: MonthValue = TBFH104_DefineMonthFromExcelFilePath(FromWBPath): FromWSEachRowData(1) = MonthValue
    Dim GroupValue As String
    Dim TeamValue As String
    Dim StaffID As String
    Dim StaffName As String
    Dim ProjectCode As String
    Dim CustomerName As String
    Dim ProjectName As String
    Dim FromWSEndRow As Integer
    For Each FromWS In FromWB.Sheets
            FromSheetname = FromWS.Name
        'Check FromSheetname is Staff Name
            IsStaffName = HCF4086_IsInArr2Chieu_NumberOrString(StaffManagerArr, 2, FromSheetname)
            If IsStaffName = False Then GoTo GoToExitLoop
            StaffName = FromSheetname
            GroupValue = TBFH105_GetStaffInformationFromPCNo_StaffID_StaffName(StaffName, "FromName", "GNo")
            TeamValue = TBFH105_GetStaffInformationFromPCNo_StaffID_StaffName(StaffName, "FromName", "TeamNo")
            StaffID = TBFH105_GetStaffInformationFromPCNo_StaffID_StaffName(StaffName, "FromName", "ID")
            FromWSEachRowData(2) = GroupValue
            FromWSEachRowData(3) = TeamValue
            FromWSEachRowData(4) = StaffID
            FromWSEachRowData(5) = StaffName
        'Define FromWSEndRow
            Call HCF4079_DefineRowEndNo(FromWS, FromWSEndRow, 34)
            If FromWSEndRow <= 3 Then GoTo GoToExitLoop
            FromWSEndRow = FromWSEndRow - 2
        'Define EachSheetData
            Dim CheckRowValue As String
            For f = 4 To FromWSEndRow
                CheckRowValue = FromWS.Cells(f, 34).Value
                If CheckRowValue <> "" Then
                    ProjectName = FromWS.Cells(f, 2).Value
                    ProjectCode = TBFH106_GetProjectInformationFromProjectName(ProjectName, "ProjectCode")
                    CustomerName = TBFH106_GetProjectInformationFromProjectName(ProjectName, "CustomerName")
                    If CustomerName = "" Then CustomerName = FromWS.Cells(f, 1).Value
                    FromWSEachRowData(6) = ProjectCode
                    FromWSEachRowData(7) = CustomerName
                    FromWSEachRowData(8) = ProjectName
                    For k = 3 To 34
                        FromWSEachRowData(k + 6) = FromWS.Cells(f, k).Value
                    Next
                    ReDim Preserve FromWSData(0 To FromWSDataRowNo)
                    FromWSData(FromWSDataRowNo) = FromWSEachRowData
                    FromWSDataRowNo = FromWSDataRowNo + 1
                End If
            Next
        'Write ChuuKiRan
            Dim ChuuKiRanIsEmpty As Boolean
            Dim ChuuKiRanRowNo As Integer: ChuuKiRanRowNo = FromWSEndRow + 4
            ChuuKiRanIsEmpty = TBFH108_CheckRangeIsEmpty(FromWS, ChuuKiRanRowNo, 3, 34)
            If ChuuKiRanIsEmpty = False Then
                FromWSEachRowData(6) = ""
                FromWSEachRowData(7) = ""
                FromWSEachRowData(8) = FromWS.Cells(ChuuKiRanRowNo, 2).Value
                For k = 3 To 34
                    FromWSEachRowData(k + 6) = FromWS.Cells(ChuuKiRanRowNo, k).Value
                Next
                ReDim Preserve FromWSData(0 To FromWSDataRowNo)
                FromWSData(FromWSDataRowNo) = FromWSEachRowData
                FromWSDataRowNo = FromWSDataRowNo + 1
            End If
        'Write KinTai
            Dim KinTaiRowNo As Integer: KinTaiRowNo = FromWSEndRow + 5
            FromWSEachRowData(6) = ""
            FromWSEachRowData(7) = ""
            FromWSEachRowData(8) = FromWS.Cells(KinTaiRowNo, 2).Value
            For k = 3 To 34
                FromWSEachRowData(k + 6) = FromWS.Cells(KinTaiRowNo, k).Value
            Next
            ReDim Preserve FromWSData(0 To FromWSDataRowNo)
            FromWSData(FromWSDataRowNo) = FromWSEachRowData
            FromWSDataRowNo = FromWSDataRowNo + 1
GoToExitLoop:
    Next
    FromWB.Close False
Next
'Write FromWSData to DataBase
    If FromWSDataRowNo = 0 Then GoTo GotoExitSub
'Define WriteRowFrom
    Dim WriteRowFrom As Integer
    Call HCF4079_DefineRowEndNo(ToWS, WriteRowFrom, 1)
    WriteRowFrom = WriteRowFrom + 1
    Dim EachRowData As Variant
    Dim EachValue As String
    For i = LBound(FromWSData) To UBound(FromWSData)
        EachRowData = FromWSData(i)
        For k = LBound(EachRowData) To UBound(EachRowData)
            EachValue = EachRowData(k)
            If EachValue <> "" Then
                ToWS.Cells(WriteRowFrom, k) = EachRowData(k)
            End If
        Next
        WriteRowFrom = WriteRowFrom + 1
    Next
GotoExitSub:
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Finish"
End Sub