Snasui Excel Forum

Code: Select all

Option Explicit
Dim File_Path As String
Const Consolidation_Sheet_Name As String = "Consolidation"
Const Source_Sheet_Name As String = "Record"
Const Start_Consolidated_Data_Row As Long = 2
Const Start_Source_Data_Cell As String = "A2"
Dim Data_Folder As String
Dim Consolidation_Sheet As Worksheet
Dim Current_Row As Long

Sub Consolidate_MTN_Data()
    Initialize
    Clear_Existed_Data
    Consolidate_Each_File
    Finalize
End Sub

Private Sub Initialize()
    Application.ScreenUpdating = False
    File_Path = ActiveWorkbook.Path & "\" & ActiveSheet.[Data_Folder] & "\"
    Set Consolidation_Sheet = ActiveWorkbook.Sheets(Consolidation_Sheet_Name)
    Current_Row = Start_Consolidated_Data_Row
End Sub
    
Private Sub Clear_Existed_Data()
Dim Start_Clearing_Cell As String
    Start_Clearing_Cell = "A" & Start_Consolidated_Data_Row
    Consolidation_Sheet.Select
    Consolidation_Sheet.Range(Start_Clearing_Cell, Range(Start_Clearing_Cell).SpecialCells(xlLastCell)).Clear
End Sub

Private Sub Consolidate_Each_File()
Dim Data_File_Name As String

    Data_File_Name = Dir(File_Path)
    Do While Data_File_Name > ""
        Open_Data_File File_Path & Data_File_Name
        Data_File_Name = Dir()
    Loop
End Sub

Private Sub Open_Data_File(Data_File As String)
Dim Data_Workbook As Workbook
Dim Data_WorkSheet As Worksheet

    Set Data_Workbook = Workbooks.Open(Data_File, , True)
        If Is_Source_Sheet_Existed(Data_Workbook, Source_Sheet_Name) Then
            Set Data_WorkSheet = Data_Workbook.Sheets(Source_Sheet_Name)
            Copy_Data_from_Source_to_Consolidation_Sheet Data_WorkSheet
        End If
    
    Set Data_WorkSheet = Nothing
    Data_Workbook.Close
    Set Data_Workbook = Nothing
    
End Sub

Private Function Is_Source_Sheet_Existed(Data_Workbook As Workbook, Source_Sheet_Name As String) As Boolean
Dim Result As Boolean
Dim Return_Sheet_Name As String

On Error GoTo ErrorHandle
    
    Result = False
    Return_Sheet_Name = Data_Workbook.Sheets(Source_Sheet_Name).Name
    Result = True
    
ErrorHandle:
    Is_Source_Sheet_Existed = Result
End Function

Private Sub Copy_Data_from_Source_to_Consolidation_Sheet(Data_WorkSheet As Worksheet)
Dim Data_Rows As Long
Dim Source_Data_Range As Range
Dim Target_Cell As Range
    Set Source_Data_Range = Data_WorkSheet.Range(Range(Start_Source_Data_Cell), Range(Start_Source_Data_Cell).SpecialCells(xlLastCell))
    Set Target_Cell = Consolidation_Sheet.Range("A" & Current_Row)
    Source_Data_Range.Copy Target_Cell

    Current_Row = Current_Row + Source_Data_Range.Rows.Count + 1

    Set Target_Cell = Nothing
End Sub

Private Sub Finalize()
    Consolidation_Sheet.Range("A1").Select
    Set Consolidation_Sheet = Nothing
    Application.ScreenUpdating = True
End Sub

Sub Clear_Data()
    ActiveSheet.Range("A2", Range("A2").SpecialCells(xlLastCell)).Clear
End Sub

Code: Select all

Sub Clear_Data()
    With Worksheets("Consolidation")
        .Range("a2", .Range("a" & .Rows.Count).End(xlUp)) _
            .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
'    ActiveSheet.Range("A2", Range("A2").SpecialCells(xlLastCell)).Clear
End Sub

Code: Select all

Option Explicit
Dim File_Path As String
Const Consolidation_Sheet_Name As String = "Consolidation"
Const Source_Sheet_Name As String = "Record"
Const Start_Consolidated_Data_Row As Long = 3
Const Start_Source_Data_Cell As String = "A3"
Dim Data_Folder As String
Dim Consolidation_Sheet As Worksheet
Dim Current_Row As Long

Sub Consolidate_MTN_Data()
    Initialize
    Clear_Existed_Data
    Consolidate_Each_File
    Clean_Data
    Sort_Data
    Finalize
End Sub

Private Sub Initialize()
    Application.ScreenUpdating = False
    File_Path = ActiveWorkbook.Path & "\" & ActiveSheet.[Data_Folder] & "\"
    Set Consolidation_Sheet = ActiveWorkbook.Sheets(Consolidation_Sheet_Name)
    Current_Row = Start_Consolidated_Data_Row
End Sub
    
Private Sub Clear_Existed_Data()
Dim Start_Clearing_Cell As String
    Start_Clearing_Cell = "A" & Start_Consolidated_Data_Row
    Consolidation_Sheet.Select
    Consolidation_Sheet.Range(Start_Clearing_Cell, Range(Start_Clearing_Cell).SpecialCells(xlLastCell)).Clear
End Sub

Private Sub Consolidate_Each_File()
Dim Data_File_Name As String

    Data_File_Name = Dir(File_Path)
    Do While Data_File_Name > ""
        Open_Data_File File_Path & Data_File_Name
        Data_File_Name = Dir()
    Loop
End Sub

Private Sub Open_Data_File(Data_File As String)
Dim Data_Workbook As Workbook
Dim Data_WorkSheet As Worksheet

    Set Data_Workbook = Workbooks.Open(Data_File, , True)
        If Is_Source_Sheet_Existed(Data_Workbook, Source_Sheet_Name) Then
            Set Data_WorkSheet = Data_Workbook.Sheets(Source_Sheet_Name)
            Copy_Data_from_Source_to_Consolidation_Sheet Data_WorkSheet
        End If
    
    Set Data_WorkSheet = Nothing
    Data_Workbook.Close
    Set Data_Workbook = Nothing
    
End Sub

Private Function Is_Source_Sheet_Existed(Data_Workbook As Workbook, Source_Sheet_Name As String) As Boolean
Dim Result As Boolean
Dim Return_Sheet_Name As String

On Error GoTo ErrorHandle
    
    Result = False
    Return_Sheet_Name = Data_Workbook.Sheets(Source_Sheet_Name).Name
    Result = True
    
ErrorHandle:
    Is_Source_Sheet_Existed = Result
End Function

Private Sub Copy_Data_from_Source_to_Consolidation_Sheet(Data_WorkSheet As Worksheet)
Dim Data_Rows As Long
Dim Source_Data_Range As Range
Dim Target_Cell As Range
    Set Source_Data_Range = Data_WorkSheet.Range(Range(Start_Source_Data_Cell), Range(Start_Source_Data_Cell).SpecialCells(xlLastCell))
    Set Target_Cell = Consolidation_Sheet.Range("A" & Current_Row)
    Source_Data_Range.Copy Target_Cell

    Current_Row = Current_Row + Source_Data_Range.Rows.Count + 1

    Set Target_Cell = Nothing
End Sub
Private Sub Clean_Data()
  With Worksheets("Consolidation")
   .Range("a3", .Range("a" & .Rows.Count).End(xlUp)) _
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
End Sub
Private Sub Sort_Data()
  Columns("A:A").Select
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Consolidation").Sort.SortFields.Add Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Consolidation").Sort
        .SetRange Range("A3:AY433")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Private Sub Finalize()
    Consolidation_Sheet.Range("A1").Select
    Set Consolidation_Sheet = Nothing
    Application.ScreenUpdating = True
End Sub
Sub Clear_Data()
    ActiveSheet.Range("A3", Range("A3").SpecialCells(xlLastCell)).Clear
End Sub