Link to home
Start Free TrialLog in
Avatar of Ted Penner
Ted PennerFlag for United States of America

asked on

Fix insertion and shifting issue

I had this question after viewing this Debug combiner.

The code below for the attached macro and test files seem to move all data over two columns, thus ignoring the first two columns all together.

The macro should continue to be agnostic. It should not matter what columns are there, and the only column that should be inserted if it does not already exist is the first one which should be called "Filename".

Assistance in fixing this is greatly appreciated.160401-File-Row-Combiner.xlsbFileA.xlsxFileB.xlsx

FUNCTION:
Option Explicit

Public Function UseFolderDialogOpen() As String
    Dim lngCount As Long

    ' Open the folder dialog
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show

        ' Set Current Folder Path
        For lngCount = 1 To .SelectedItems.Count
            UseFolderDialogOpen = .SelectedItems(lngCount)
        Next lngCount

    End With

End Function

Open in new window


MAIN CODE:
Option Explicit
Sub simpleXlsMerger()
    Dim wsTable As Worksheet, ws As Worksheet
    Dim rRng As Range
    


    Dim bookList As Workbook
    Dim path As String, MyName As String
    Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object


    Dim rToCopy As Range, rNextCl As Range
    Dim bHeaders As Boolean

    Dim fRow As Long, lRow As Long


    Set ws = ActiveSheet
    Set mergeObj = CreateObject("Scripting.FileSystemObject")

    'change folder path of excel files here
    path = UseFolderDialogOpen
    If path = "" Then Exit Sub
    Set dirObj = mergeObj.Getfolder(path)
    Set filesObj = dirObj.Files

    On Error GoTo exit_Proc
    For Each everyObj In filesObj
        Set bookList = Workbooks.Open(everyObj)

        'Grab filename from each open file

        MyName = everyObj.Name

        With ws

            Set rRng = .Range("A1").CurrentRegion
            If rRng.Cells.Count = 0 Then
                'no data in master sheet
                bHeaders = False
            Else: bHeaders = True
            End If
            If Not bHeaders Then
                Set rNextCl = .Cells(1, 2)
                bHeaders = True
            Else: Set rNextCl = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 2)
                'headers exist so don't copy
            End If

        End With

        With ActiveSheet

            If bHeaders Then
                Set rToCopy = .Range("A1").CurrentRegion.Offset(1)
            Else: Set rToCopy = .Range("A1").CurrentRegion
            End If
            rToCopy.Copy rNextCl.Offset(, 1)

            lRow = ws.Cells(1, 1).CurrentRegion.Rows.Count

            'Paste site name to column A
            ws.Range("A" & rNextCl.Row & ":" & "A" & lRow).Value = Left(MyName, Len(MyName) - 5)

        End With

        bookList.Close False

    Next
exit_Proc:
    '    With wsTable
    '        'make all cells same height
    '        .Rows.RowHeight = 15
    '
    '        'convert sheet2 into table
    '        Set rRng = .Range("A1").CurrentRegion
    '        '        If rRng.ListObject.Name <> "" Then
    '        '            MsgBox "Table already exists", vbCritical, "Abort"
    '        '            Exit Sub
    '        '        Else: .ListObjects.Add(xlSrcRange, rRng, , xlYes).Name = "MyTable"
    '        '        End If
    '    End With
End Sub

Open in new window

Avatar of Roy Cox
Roy Cox
Flag of United Kingdom of Great Britain and Northern Ireland image

Should be easier with some example files.

I thought you wanted the file name in the first column. This line was in your original code


     
      'Paste site name to column A
            ws.Range("A" & rNextCl.Row & ":" & "A" & lRow).Value = Left(MyName, Len(MyName) - 5)

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Roy Cox
Roy Cox
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Ted Penner

ASKER

That works, but does not create the first column for the Filename, or check to see if column Filename already exists.
Pleased to help, I'll post code to amend what you want later