2

New to the site with weak VBA skills. Hoping I can find some assistance with something I have been struggling with for days. I have found many examples that are close, and cant seem to marry them together. I am using Excel 2007. I have a "Summary_Reports" WB, as well as several other workbooks named by employee (eg. "Jim.xls", "bob.xls", etc). Each of the employee workbooks has a named range "caps" sourced from sheet "Tasks". This named range in each employee wb is the same width (number of columns) but can vary in height (number of rows), and some of the rows may be empty. Trying to setup a macro in "Summary_Reports" wb that will open each of the employees wb, copy the named range "caps", and insert/paste only the rows of that range containing data in the first column, to the "Report" sheet in the "Summary_Reports" wb. I assumed the easiest paste method would just be to pick a cell at the top and always insert those rows there, that way each employee would just get inserted above the previous one starting at the same spot. That way no counting or looking for the last populated row on the sheet. I attempted at first to open "Jim.xls" and copy the named range directly from the workbook, but had little success and a lot of trouble with syntax. So I ended up with the code below that pulls the employee sheet into "Summery_Reports" and then copies the named range from itself instead of another wb. Would probably end up deleting those sheets at the end.

What I have started below kinda works, but the data validation I know isn't correct. Correct me if I am wrong but it is only checking the top left cell of "caps" right; if there are contents, it pastes all of "caps", and if that single cell is empty, it pastes nothing. How do I correct the validation to check the first column of every row and also how do I get it to just give me the rows with data?

Also, I know there is a better way to get the "caps" data directly from each of the employee wb, without importing the sheet first. If that can be done easily, I would be very interested in any advice in that regard.

If you are kind enough to help me, please dumb it down as much as possible as I am really interested in actually knowing what the code does and not just copying and pasting. Thank you in advance.

Sub Import_Sheets()
Application.Workbooks.Open ("jim.xls")
Workbooks("jim.xls").Activate
Sheets("Tasks").Copy After:=Workbooks("Summary_Report.xlsm").Sheets("Report")
Application.Workbooks("Jim.xls").Close

'Go to newly copied sheet and name it.
ActiveSheet.Name = "jim"

'Copy the "caps" named range.
With Range("Caps")
    If .Cells(1, 1).Value = "" Then
    Else
        Range("Caps").Select
        Selection.Copy
        Sheets("Report").Select
        Range("B2").Select
        Selection.Insert Shift:=xlDown
    End If
End With
End Sub
Community
  • 1
  • 1

1 Answers1

2

Commented code:

Sub Import_Sheets()

    'Declare variables
    Dim wsDest As Worksheet 'This is the sheet that data will be pasted to
    Dim rngCaps As Range    'This is used to determine if there is a named range "Caps"
    Dim rngFound As Range   'This is used to loop through the first column in the named range "Caps"
    Dim rngSearch As Range  'This is used to determine where to search
    Dim rngCopy As Range    'This is used to store the rows with data that will be copied
    Dim strFirst As String  'This is used to store the first cell address to prevent an infinite loop
    Dim i As Long           'This is used to loop through the selected workbooks

    'Create an "Open File" dialogue for the user to choose which files to import
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear                          'Clear existing filters (if any)
        .Filters.Add "Excel Files", "*.xls*"    'Filter for Excel files
        .AllowMultiSelect = True                'Allow user to select multiple files at a time with Shift or Ctrl

        If .Show = False Then Exit Sub  'Pressed cancel, exit macro

        'The destination is this workbook, sheet 'Report'
        Set wsDest = ActiveWorkbook.Sheets("Report")

        'Turn off screenupdating.  This prevents "Screen Flickering" and allows the code to run faster
        Application.ScreenUpdating = False

        'Begin loop through selected files
        For i = 1 To .SelectedItems.Count

            'Open a selected file
            With Workbooks.Open(.SelectedItems(i))

                'Attempt to find a sheet named 'TimeEntry' with a named range "Caps"
                On Error Resume Next
                Set rngCaps = .Sheets("TimeEntry").Range("Caps")
                On Error GoTo 0 'Remove the On Error Resume Next condition

                'Was it able to set rngCaps successfully?
                If Not rngCaps Is Nothing Then
                    'Yes, proceed to find rows with data
                    'Define rngSearch which will be used to find rows with data
                    Set rngSearch = Intersect(rngCaps, rngCaps.Cells(1).MergeArea.EntireColumn)

                    'Use a find loop to only get rows with data
                    'We can do this by utilizing the wildcard *
                    'The .Resize(, 1) will make sure we are only looking in the first column of rngCaps
                    Set rngFound = rngSearch.Find("*", rngSearch.Cells(rngSearch.Cells.Count), xlValues, xlWhole)

                    'Was there a cell found with data?
                    If Not rngFound Is Nothing Then
                        'Yes, record this first cell's address to prevent infinite loop
                        strFirst = rngFound.Address

                        'Also start storing the rows where data was found
                        Set rngCopy = rngFound

                        'Begin the find loop
                        Do
                            'Add found rows to the rngCopy variable
                            Set rngCopy = Union(rngCopy, rngFound)

                            'Advance loop to the next cell that contains data
                            Set rngFound = rngSearch.Find("*", rngFound, xlValues, xlWhole)

                        'Exit the loop when we are back to the first cell
                        Loop While rngFound.Address <> strFirst

                        'Copy the rows with data and paste them into the next available row in the destination worksheet
                        Intersect(rngCaps, rngCopy.EntireRow).Copy wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1)

                        'Clear rngFound and rngCopy to get ready for next workbook
                        Set rngFound = Nothing
                        Set rngCopy = Nothing
                    End If

                    'Clear rngCaps to get ready for next workbook
                    Set rngCaps = Nothing
                End If

                'Close this opened workbook and don't save changes
                .Close False
            End With

        'Advance to the next workbook that was selected
        Next i

        'Re-enable screen updating
        Application.ScreenUpdating = True

        'Object variable cleanup
        Set wsDest = Nothing

    End With

End Sub
tigeravatar
  • 26,199
  • 5
  • 30
  • 38
  • tigeravatar... Thank you for the extremely detailed info...I hope the amount of time you spent wasn't nearly much as it appears. I have been struggling with your response for some time. Originally it seemed to work, but I was getting no results and thought the error was with my data. I spent a lot of time trying to very closely understand all the code, and for a good part of it, I get it. After a lot of testing and playing around, I think the problem is my fault because I didn't mention the range contains merged cells and comments. It works with a straight forward range. Not a complex one. – user2708252 Sep 30 '13 at 18:27
  • 1
    Generally speaking, merged cells should always be avoided. If it is too late for you to have non-merged cells, I would need to see a sample file in order to tailor the macro to your needs. Unfortunately, there isn't really a "one size fits all" solution when it comes to merged cells (and one of many reasons they should be avoided). – tigeravatar Sep 30 '13 at 19:04
  • I would happily upload a copy of the source file for you to look at or even a jpg view of it, but I am not seeing anything in help section on doing so or on how to send directly to you. – user2708252 Sep 30 '13 at 19:43
  • You would need to upload to a file sharing site (preferably one that doesn't require a login). I use google drive, but it is simply one of many. Once you have uploaded it, you would put a link to the document here. – tigeravatar Sep 30 '13 at 19:45
  • The two ranges in that file are the ones ultimately I want to bring into the report file. All the "Caps" for each person on one sheet and all the "NonCaps" for each person on another sheet. The columns would not change, however, people may add rows into both named ranges. That is why I went with the named range because if they do an insert in the middle of the named range, it should dynamically change the named range and my copy would ultimately pull in the NEW named range. If that makes any sense. – user2708252 Sep 30 '13 at 20:02
  • Actually, I took your advice and am trying to eliminate the merged cells and update formulas and scripts accordingly. They were more of a left over from previous versions, so with some adjustment I think I can get them removed since you suggest that is the best way. – user2708252 Sep 30 '13 at 20:55
  • I have updated the answer in order to edit the code and comments so that it will work with your provided example file. I have tested it and it returned the intended information successfully – tigeravatar Sep 30 '13 at 21:01
  • You have been extremely helpful and it is working great. Thank you very much tigeravatar. – user2708252 Oct 07 '13 at 15:09