Combining multiple workbooks with single sheets into one workbook with multiple sheet

boombox · Feb 27th 2012

I am trying to use this code. It has worked very well in the past but has stopped working for some reason.

Here is mine code:-

Code

Option Explicit
 
 '32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
pszpath As String) As Long
 
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long
 
Public Type BrowseInfo
    hOwner As Long
    pIDLRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type
 
Function GetDirectory(Optional msg) As String
    On Error Resume Next
    Dim bInfo As BrowseInfo
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
     
     'Root folder = Desktop
    bInfo.pIDLRoot = 0&
     
     'Title in the dialog
    If IsMissing(msg) Then
        bInfo.lpszTitle = "Where those files at?"
    Else
        bInfo.lpszTitle = msg
    End If
     
     'Type of directory to return
    bInfo.ulFlags = &H1
     
     'Display the dialog
    x = SHBrowseForFolder(bInfo)
     
     'Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    If r Then
        pos = InStr(path, Chr$(0))
        GetDirectory = Left(path, pos - 1)
    Else
        GetDirectory = ""
    End If
End Function
Sub CombineC2GFiles()
    Dim path            As String
    Dim FileName        As String
    Dim LastCell        As Range
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
    Dim ThisWB          As String
     
    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = GetDirectory
    FileName = Dir(path & "\*.csv", vbNormal)
    Do Until FileName = ""
        If FileName <> ThisWB Then
            Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
            For Each WS In Wkb.Worksheets
                Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
                If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
                Else
                    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                End If
            Next WS
            Wkb.Close False
        End If
        FileName = Dir()
    Loop
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
    Set Wkb = Nothing
    Set LastCell = Nothing
End Sub

Display More

I've modified it to combine CSV files.

Now, it breaks and says 'type mismatch' on this line:

Code

If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then

Aside from that, I'd like to install this in my personal macro workbook - but have the "result" (the combined workbook) in a new, blank workbook.

Any tips?

THANKS!

boombox · Feb 28th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Polite bump!

**cytop** · Feb 28th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

The code works fine for me... no issues whatsoever.

Perhaps if you posted an (anonymous, cut-down if necessary) copy of your original workbook with the code and a sample of the CSV files, it could be tested with the actual data you/re using?

boombox · Feb 28th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thanks, this prompted me to look at my data. Two workbooks only had data on row1. Adding data to row2 resolved the error. I've no idea how to add error checking for that. I don't these particular workbooks merged (row 1 is a header row, so the workbook is effectively empty) but it would be nice for the code not to fail is there is no row2.

Otherwise, I'm still looking for a way to store the code in personal but perform/store the merge in a new workbook.

THANKS!!

**cytop** · Feb 28th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Just add a check...

Code

If LastCell.Row > 1 then
      '// process it
      ...
   End If

Please don't requote posts. it clutters things and the post is available to read by scrolling up a little...

boombox · Feb 29th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Sorry about quoting posts. In another programming forum it's encouraged and common practice due to people deleting or editing posts. I shan't do it here!

I've tried to implement your check as you posted it, and got a type mismatch. When I tried to peg it on to the end of an existing IF, I get a type mismatch.

Any ideas?

Code

Do Until FileName = ""
        If FileName <> ThisWB Then
            Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
            For Each WS In Wkb.Worksheets
                    Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
                    If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address And LastCell.Row > 1 Then
                    Else
                        WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                    End If
                Next WS
                Wkb.Close False
            End If
        FileName = Dir()
    Loop

Display More

Thanks!

**cytop** · Feb 29th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Changed slightly... Try this:

Code

Do Until Filename = ""
    If Filename <> ThisWB Then
        Set Wkb = Workbooks.Open(Filename:=Path & "\" & Filename)
        For Each WS In Wkb.Worksheets
            Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
            
               If LastCell.Value = vbNullString And LastCell.Row <= 2 Then
                  '// Do nothing
               Else
                   WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
               End If


            
        Next WS
        Wkb.Close False
    End If
    Filename = Dir()
Loop

Display More

I'm not saying that's the most elegant way of doing that - it's just the quickest and easiest - but you need to verify the check is valid.

boombox · Feb 29th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thanks - but the code generates a type mismatch on

Code

If LastCell.Value = vbNullString And LastCell.Row <= 2 Then

No problems if the more or less empty workbooks aren't in the target folder.

**cytop** · Feb 29th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Works for me... Can you post an anonymous/cut-down copy of your workbook?

boombox · Mar 2nd 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Quote from cytop;597818

Works for me... Can you post an anonymous/cut-down copy of your workbook?

Please find attached

forum.ozgrid.com/index.php?attachment/44197/

And thank you!

boombox · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

World's politest bump ever.

**cytop** · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Sorry - didn't see your attachment as it scrolled off the first page - and I rarely move off page 1.

The issue is because you have an error in the last cell in one file. I realise this is a one row file in any case but you cannot evaluate a function with an error.

Not sure exactly what you want to do. Report the fact there's an error? But then it'll only report those files that have an error in the last cell which in not very likely unless that's a result of other processing and any such files will only have one line of data... or just import regardless.

Code below has 2 options:

1. Import errors. You can then use the consolidated file to find errors
2. Don't import, but report that files were skipped due to data error/no data/

Code

Sub CombineC2GFiles()
    Dim path            As String
    Dim FileName        As String
    Dim LastCell        As Range
    Dim Wkb             As Workbook
    Dim WS              As Worksheet
    Dim ThisWB          As String
     
    Dim strMessage      As String
    
    ThisWB = ThisWorkbook.Name
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    path = GetDirectory
    FileName = Dir(path & "\*.csv", vbNormal)
    
    Do Until FileName = ""
      
      If FileName <> ThisWB Then
      
          Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
          
          For Each WS In Wkb.Worksheets
          
              Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
               
              '// Uncomment to report errors in last cell
              '// If Not IsError(LastCell.Value) Then
                  If LastCell.Row < 2 Then
                     '// Store name to report
                     strMessage = strMessage & Wkb.Name & " - No data" & vbCrLf
              '//    Else
                    WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                 End If
              '// Else
              '//    strMessage = strMessage & Wkb.Name & " - Data error last cell" & vbCrLf
              '// End If
              
          Next WS
          
          Wkb.Close False
          
      End If
      
      FileName = Dir()
      
    Loop
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
     
    '// Uncomment if you want a message box showing skipped files
    '// If strMessage <> vbNullString Then
    '//   MsgBox "The following files were skipped for whatever reason:" & _
    '//          vbCrLf & vbCrLf & strMessage, vbOKOnly, "Skipped files"
    '// End If
             
    Set Wkb = Nothing
    Set LastCell = Nothing
    
End Sub

Display More

Comment/Uncomment lines as needed.

boombox · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Thank you so much for the time you're taking on this. I tried the above with the sample data and got a new error:-

[Blocked Image: http://photoupload.org/uploads/13309601141.jpg]

**cytop** · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

Sorry, but it works for me.
Have a read of this... http://blogs.msdn.com/b/willbu…wer-rows-and-columns.aspx

boombox · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

I give up. Thank you for your time anyway!

**cytop** · Mar 5th 2012

Re: Combining multiple workbooks with single sheets into one workbook with multiple s

That error (and I can't check this as am using 2003 at the moment) seems to occur when you use the workbook on machines with XL2007 (or later) & XL2003 and is related to the max allowed number of rows and columns in the different versions. Sorry but the code works fine for me on 2003 so am unable to comment further.

Combining multiple workbooks with single sheets into one workbook with multiple sheet

Participate now!

Share