Multiple file selection for data consolidation

[NandoR]

Hello MrExcel Team,

I was messing a little bit with many threats here and I cannot found a proper solution. Bellow the code and the explanation:

I open several excel sheets with the very same layout in order to consolidate especific cells. The problem is that the files selected are not accesible and no info is capture to consolidate. The quote for the consolidation is created but not in the proper way. I have no idea how to solve it. Any hint would be very welcome. Thanks!!!

Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
SetCurrentDirectoryA szPath
End Sub

Sub ConsolidateRegions()
Dim MyPath As String
Dim Fnum As Long
Dim rnum As Long, CalcMode As Long
Dim SaveDriveDir As String
Dim sFile As Variant
Dim i As Long
Dim SheetArg() As String
Dim sPath1 As String
Dim sPath As String
Dim SelectedFiles() As Variant
Dim FileName As String
Dim FileName2 As String
Dim NFile As Long
Dim LengthPath As Integer
Dim LengthName As Integer
Dim Rest As Integer

'With Application
' CalcMode = .Calculation
' .Calculation = xlCalculationManual
' .ScreenUpdating = False
' .EnableEvents = False
'End With



SaveDriveDir = CurDir
ChDirNet "C:\Users\XXX\Documents\Task\"

'Select files

SelectedFiles = Application.GetOpenFilename(<wbr>filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)


i = 0

sPath = "C:\Users\XXX\Documents\Task\"

'Create dynamic vector
ReDim SheetArg(1 To 1)

‘ReDim SheetArg2(1 To 1)

'Populate the vector the the taylor made strings by filtering the file name each time
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)

i = i + 1
FileName = SelectedFiles(NFile)
LengthPath = Len(sPath)
LengthName = Len(FileName)
Rest = LengthName - LengthPath
FileName = Right(FileName, Rest - 8)
ReDim Preserve SheetArg(1 To i)
'ReDim Preserve SheetArg2(1 To i)
'MsgBox sPath, vbInformation
SheetArg(i) = Chr(34) & Chr(39) & "C:\Users\XXX\Documents\Task\" & "[" & FileName & "]Results" & Chr(39) & "!R7C10:R19C11" & Chr(34)
'SheetArg(i) = "'" & sPath & "[" & FileName & "]Results'!R7C10:R19C11"
'SheetArg2(i) = "'" & sPath & "[" & FileName & "]Results'!R7C17:R28C18"
Next NFile
'MsgBox SheetArg(1), vbInformation
'MsgBox SheetArg(2), vbInformation

'Execute the consolidate function. Here the array is not working
Sheets("Divisions").Range("C7"<wbr>).Consolidate Sources:=Array(SheetArg()), Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

'Sheets("Regions").Range("C7")<wbr>.Consolidate Sources:=Array(SheetArg2), Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False
ChDirNet SaveDriveDir
End Sub

 

[NandoR]

Hello team. Let's do it simple. I have in the array every single string that I want. However, when I use the function consolidate with such array the error is that the file is not reachable a show me a truckated version of my string in each position of the array. Any suggestion from anyone?

 

[Jerry Sullivan]

Hi NandoR,

There's a few syntax problems keeping that from working.
1. The elements in the SheetArg array shouldn't have literal quotes at the front and end of the string.
2. Since SheetArg is already an array, it should be used directly as the Sources parameter instead of wrapped in an Array function.
3. The technique of extracting the filename from the full name wasn't quite right.

Below is a modified version for you to try.

Sub ConsolidateRegions()
 Dim lNFile As Long
 Dim sSaveDriveDir As String
 Dim sSourceArray() As String
 Dim sFullName As String, sFileName As String
 Dim vSelectedFiles() As Variant

 Const sPath As String = "C:\Users\XXX\Documents\Task\"

 sSaveDriveDir = CurDir
 ChDirNet sPath
 
 'Select files
 vSelectedFiles = Application.GetOpenFilename( _
   filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
 
 'Create dynamic vector
 ReDim sSourceArray(LBound(vSelectedFiles) To UBound(vSelectedFiles))

 'Populate the vector with source references
 For lNFile = LBound(vSelectedFiles) To UBound(vSelectedFiles)
   sFullName = vSelectedFiles(lNFile)
   sFileName = Right(sFullName, Len(sFullName) - Len(sPath))
   sSourceArray(lNFile) = _
      Chr(39) & sPath & "[" & sFileName & "]Sheet1" & Chr(39) & "!R7C10:R19C11"
 Next lNFile
   
 'Execute the consolidate function.
 Sheets("Divisions").Range("C7").Consolidate Sources:=sSourceArray, _
   Function:=xlSum, TopRow:=False, LeftColumn:=False, CreateLinks:=False

 ChDirNet sSaveDriveDir
End Sub

 

[NandoR]

Good evening Mr. Sullivan,

Thanks for your prompt answer to my question. I was trying to apply the solution provided and it is much more elegant and clean than my messy one. However, I find the very same problem and the consolidation doesnt work. The file is unreachable in any try. Error: Cannot open source file:...

Files are closed when I execute the macro, but even if the are open, the consolidation does not end up properly. Source files cannot be open. Any suggestion for me to try? Thanks for your support in advanced!!!

 

[Jerry Sullivan]

Hi NandoR,

That code works for me- regardless of whether the files are open or closed.

Do you have a sheet named "Sheet1" in each workbook?

I'd suggest you do the consolidation manually with just 2 workbooks with the macro recorder on.
Then try running the macro adding a Debug.Print statement that sends the each file string to the Immediate Window of the VB Editor.

 'Populate the vector with source references
 For lNFile = LBound(vSelectedFiles) To UBound(vSelectedFiles)
   sFullName = vSelectedFiles(lNFile)
   sFileName = Right(sFullName, Len(sFullName) - Len(sPath))
   sSourceArray(lNFile) = _
      Chr(39) & sPath & "[" & sFileName & "]Sheet1" & Chr(39) & "!R7C10:R19C11"
   Debug.Print sSourceArray(lNFile)
 Next lNFile

If you aren't able to find the problem by comparing those, please post the recorded macro and output printed to the Immediate Window.

 

[NandoR]

Dear Mr. Sullivan, thanks a lot for those valuable hints. The code as you mentioned was clean and functional, but my blindness was bigger. The problem was located in sPath code (only a missing s in the folder Source{s}) that I slightly changed for other purposes, so at the end with the help of the Immediate screen information I was able to debug the problem and solve it. Your code as I mentioned before was perfect from the very beginning, and I am so sorry because of bothering you with my questions. I wish you to see you soon in Denver. And if you like Basketball congrats for the nice season of Denver Team. I will keep in touch!!!!

 

[Jerry Sullivan]

NandoR, I'm glad you were able to sort that out. Cheers!