Combining 2 Excel vba Scripts

Question

I am just beginning with vba and trying to understand forum etiquette. Please forgive me. I have inherited three scripts from an ex-coworker that I would like to merge together. All work fine when running separately, and part 1 and part 3 work when combined, but once I add part 2 to the mix, I can see only parts 1 & 3 completed. Part 1 = add filename of each .csv to a cell inside each worksheet of a folder. Part 2 = rotate table data horizontally and vertically of each .csv inside the folder. Part 3 = merge all .csv worksheets into a single worksheet.

Sub AddBarcodeFilenameRotateMergeData()

    Dim wbk As Workbook
    Dim Filename As String
    Dim Path As String
    Dim lSecurity As Long
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceRcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    
    ' ***** Part 1 - Open each .csv file in Data folder, add each filename to cell A3 of each worksheet.

    ' Folder of data files.
    Path = "S:\User\Data\"

    ' Format of data files.
    Filename = Dir(Path & "*.csv")

    ' Don't Open MasterFile.
    Do While Filename <> "" And Filename <> "Master.xlsm"
    Set wbk = Workbooks.Open(Path & Filename)
    lSecurity = Application.AutomationSecurity
    Application.AutomationSecurity = msoAutomationSecurityLow

    For Each ws In wbk.Worksheets
        With ws
            Range("A3").Select
            ActiveCell.FormulaR1C1 = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)
        End With
    Application.AutomationSecurity = lSecurity
    Next ws
wbk.Close True
Filename = Dir

Loop

    ' ***** Part 2 - After each filename has been added to cell A3 of all worksheets in folder, rotate A10:X25 table data of all worksheets vertically & horizontally.

    ' Flip Data Vertically & Horizontally

    Dim Rng As Range
    Dim WorkRng As Range
    Dim Arr As Variant
    Dim i As Integer, j As Integer, k As Integer
 
    ' Folder of data files.
    Path = "S:\BMG CLARIOstar\Data\"

    ' Format of data files.
    Filename = Dir(Path & "*.csv")
 
    Set WorkRng = Application.Selection
    Set WorkRng = Range("A10:X25")
    Arr = WorkRng.Formula
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For j = 1 To UBound(Arr, 2)
        k = UBound(Arr, 1)
            For i = 1 To UBound(Arr, 1) / 2
                xTemp = Arr(i, j)
                Arr(i, j) = Arr(k, j)
                Arr(k, j) = xTemp
                k = k - 1
            Next
    Next
 
    WorkRng.Formula = Arr
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    For i = 1 To UBound(Arr, 1)
        k = UBound(Arr, 2)
            For j = 1 To UBound(Arr, 2) / 2
                xTemp = Arr(i, j)
                Arr(i, j) = Arr(i, k)
                Arr(i, k) = xTemp
                k = k - 1
            Next
        
    Next
 
    WorkRng.Formula = Arr
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    ' Flip Header Column Vertically
    Set WorkRng = Application.Selection
    Set WorkRng = Range("D6:D21")
    Arr = WorkRng.Formula
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For j = 1 To UBound(Arr, 2)
        k = UBound(Arr, 1)
            For i = 1 To UBound(Arr, 1) / 2
                xTemp = Arr(i, j)
                Arr(i, j) = Arr(k, j)
                Arr(k, j) = xTemp
                k = k - 1
            Next
    Next
 
    WorkRng.Formula = Arr
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    ' Flip Header Row Horizontally
    Set WorkRng = Application.Selection
    Set WorkRng = Range("E5:AB5")
    Arr = WorkRng.Formula
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For i = 1 To UBound(Arr, 1)
        k = UBound(Arr, 2)
        For j = 1 To UBound(Arr, 2) / 2
            xTemp = Arr(i, j)
            Arr(i, j) = Arr(i, k)
            Arr(i, k) = xTemp
            k = k - 1
        Next
    Next
 
    WorkRng.Formula = Arr
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

     ' ***** Part 3 - Merge all worksheet data files from folder into a single worksheet.

     ' Change this to the path\folder location of data files.
     MyPath = "S:\User\Data\"

     ' Add a slash at the end of the path if needed.
     If Right(MyPath, 1) <> "\" Then
        MyPath = MyPath & "\"
    End If

     ' If there are no Excel files in the folder, exit.
     FilesInPath = Dir(MyPath & "*.csv*")
     If FilesInPath = "" Then
        MsgBox "No files found"
        Exit Sub
    End If

     ' Fill the myFiles array with the list of Excel files in the search folder.
     FNum = 0
     Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
     Loop

     ' Set various application properties.
     With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
     End With

     ' Add a new workbook with one sheet.
     Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
     rnum = 1

     ' Loop through all files in the myFiles array.
     If FNum > 0 Then
        For FNum = LBound(MyFiles) To UBound(MyFiles)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
            On Error GoTo 0

            If Not mybook Is Nothing Then
                On Error Resume Next

                ' Change this range to fit data.
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A1:X28")
                End With

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    ' If source range uses all columns then
                    ' skip this file.
                    If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceRcount = sourceRange.Rows.Count

                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "There are not enough rows in the target worksheet."
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else

                        ' Copy the file name in column A With sourceRange
                        '    BaseWks.Cells(rnum, "A"). _
                        '           Resize(.Rows.Count).Value = MyFiles(FNum)
                        ' End With Set the destination range.
                        Set destrange = BaseWks.Range("A" & rnum)

                        ' Copy the values from the source range to the destination range.
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value

                        rnum = rnum + SourceRcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If

        Next FNum
        BaseWks.Columns.AutoFit
    End If

ExitTheSub:
    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

End Sub

Cell A3 is the filename, A10:X25 is the raw data, after plate rotation, data in Cell A10 should then be the data in X25. No column headers.

Answer 1

Compiled but not tested - you should get the general idea about splitting code up into methods which encapsulate a task though.

Sub ProcessAllData()

    Const PTH As String = "S:\BMG CLARIOstar\Data\" 'datafile location
    Const PATTERN As String = "*.csv"               'file type to process
    Const RNG_WELLS As String = "A10:X25"           'ranges for data and row/col headers
    Const RNG_COPY As String = "A1:X25"
   
    Dim allFiles As Collection
    Dim fName, wb As Workbook, ws As Worksheet
    Dim fso As Object, arrData
    Dim rnum As Long, baseWs As Worksheet
    
    Set fso = CreateObject("scripting.filesystemobject")
    
    Set allFiles = GetFiles(PTH, PATTERN)
    If allFiles.Count = 0 Then
        MsgBox "No files of type '" & PATTERN & "' found in '" & PTH & "'"
        Exit Sub
    End If
    
    Set baseWs = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    rnum = 1
    
    For Each fName In allFiles
        Set wb = Workbooks.Open(fName)
        For Each ws In wb.Worksheets   'not technically needed for csv but included for xlsx
            ws.Range("A3") = fso.getbasename(wb.Name)
            FlipRange ws.Range(RNG_WELLS), True, True 'flip the well data range
            With ws.Range(RNG_COPY)
                .Copy baseWs.Cells(rnum, "A")
                rnum = rnum + .Rows.Count + 3 '3 rows between plates
            End With
        Next ws
        wb.Close False 'no save
    Next fName
    
    baseWs.Columns.AutoFit
    
End Sub

'---------------------------------------------
'Everything below here is a utility method...
'---------------------------------------------

'flip the data in a range around either or both of its horizontal(row)/vertical(column) axes
Sub FlipRange(rng As Range, FlipRows As Boolean, FlipColumns As Boolean)
    With rng
        .Value = FlipArray(.Value, FlipRows, FlipColumns)
    End With
End Sub

'Flip a 2D 1-based array around either or both of its horizontal(row)/vertical(column) axes
Function FlipArray(arr, FlipRows As Boolean, FlipColumns As Boolean)
    Dim arrOut(), ubr As Long, ubc As Long, r As Long, c As Long, rOut As Long, cOut As Long
    ubr = UBound(arr, 1)
    ubc = UBound(arr, 2)
    ReDim arrOut(1 To ubr, 1 To ubc)
    For r = 1 To ubr
        For c = 1 To ubc
            rOut = IIf(FlipRows, ubr - (r - 1), r)
            cOut = IIf(FlipColumns, ubc - (c - 1), c)
            arrOut(rOut, cOut) = arr(r, c)
        Next c
    Next r
    FlipArray = arrOut
End Function

'return a collection of all matching files in fPath
Function GetFiles(fPath As String, filePattern As String) As Collection 'of paths
    Dim f, allFiles As New Collection
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
    f = Dir(fPath & filePattern, vbNormal)
    Do While Len(f) > 0
        allFiles.Add fPath & f
        f = Dir()
    Loop
    Set GetFiles = allFiles
End Function