Attribute VB_Name = "MergePractice"
Option Explicit

Public Sub MergeFolder()
    Dim picker As FileDialog, folder As String, name As String, item As Variant
    Dim files As New Collection, source As Workbook, result As Workbook, openBook As Workbook
    Dim src As Worksheet, dst As Worksheet, lastRow As Long, nextRow As Long, r As Long
    Dim security As Long, updating As Boolean, events As Boolean
    Dim failure As String, closeFailure As Boolean
    Set picker = Application.FileDialog(msoFileDialogFolderPicker)
    If picker.Show <> -1 Then Exit Sub
    folder = picker.SelectedItems(1) & Application.PathSeparator
    name = Dir$(folder & "*.xlsx")
    Do While Len(name) > 0
        If Left$(name, 2) <> "~$" And folder & name <> ThisWorkbook.FullName Then files.Add name
        name = Dir$()
    Loop
    If files.Count = 0 Then
        MsgBox "No XLSX input files. Nothing created.": Exit Sub
    End If
    security = Application.AutomationSecurity
    updating = Application.ScreenUpdating
    events = Application.EnableEvents
    On Error GoTo Failed
    Application.AutomationSecurity = 3
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Set result = Workbooks.Add(xlWBATWorksheet)
    Set dst = result.Worksheets(1)
    dst.Name = "Merged"
    dst.Cells(1, 1).Value2 = "Branch"
    dst.Cells(1, 2).Value2 = "Sales"
    nextRow = 2
    For Each item In files
        Set src = Nothing
        Set source = Nothing
        For Each openBook In Application.Workbooks
            If StrComp(openBook.FullName, folder & CStr(item), vbTextCompare) = 0 Then
                Err.Raise vbObjectError + 656, "MergeFolder", "Input is already open. Close it yourself before retrying."
            End If
        Next openBook
        Set source = Workbooks.Open(folder & CStr(item), UpdateLinks:=0, ReadOnly:=True)
        Set src = source.Worksheets("Data")
        If CStr(src.Cells(1, 1).Value2) <> "Branch" Or CStr(src.Cells(1, 2).Value2) <> "Sales" Then
            Err.Raise vbObjectError + 650, "MergeFolder", "Expected Branch/Sales headers."
        End If
        lastRow = src.UsedRange.Row + src.UsedRange.Rows.Count - 1
        If lastRow < 2 Then Err.Raise vbObjectError + 651, "MergeFolder", "Input has no data rows."
        For r = 2 To lastRow
            If IsError(src.Cells(r, 1).Value2) Or IsError(src.Cells(r, 2).Value2) Then
                Err.Raise vbObjectError + 652, "MergeFolder", "An input cell contains an error."
            End If
            If Len(Trim$(CStr(src.Cells(r, 1).Value2))) = 0 Then
                Err.Raise vbObjectError + 653, "MergeFolder", "Branch is required on every row."
            End If
            If VarType(src.Cells(r, 2).Value2) = vbString _
                Or VarType(src.Cells(r, 2).Value2) = vbBoolean _
                Or IsEmpty(src.Cells(r, 2).Value2) _
                Or Not IsNumeric(src.Cells(r, 2).Value2) Then
                Err.Raise vbObjectError + 654, "MergeFolder", "Sales must be numeric."
            End If
        Next r
        If nextRow + lastRow - 2 > dst.Rows.Count Then Err.Raise vbObjectError + 655, "MergeFolder", "Output exceeds the row limit."
        dst.Cells(nextRow, 1).Resize(lastRow - 1, 2).Value2 = src.Range("A2:B" & lastRow).Value2
        nextRow = nextRow + lastRow - 1
        source.Close SaveChanges:=False
        Set source = Nothing
    Next item
    MsgBox CStr(nextRow - 2) & " data rows. Review the unsaved Merged workbook."
CleanUp:
    On Error Resume Next
    Err.Clear
    If Not source Is Nothing Then source.Close SaveChanges:=False
    If Err.Number <> 0 Then closeFailure = True
    Err.Clear
    If Len(failure) > 0 And Not result Is Nothing Then result.Close SaveChanges:=False
    If Err.Number <> 0 Then closeFailure = True
    Application.AutomationSecurity = security
    Application.ScreenUpdating = updating
    Application.EnableEvents = events
    On Error GoTo 0
    If Len(failure) > 0 Then MsgBox "Stopped at " & CStr(item) & ": " & failure, vbExclamation
    If closeFailure Then MsgBox "A practice workbook could not close. Inspect open workbooks; do not save partial output.", vbExclamation
    Exit Sub
Failed:
    failure = CStr(Err.Number) & ": " & Err.Description
    Resume CleanUp
End Sub
