Generate list from other files

[Joe D]

Hi Everyone,

I am trying to write a sub in a workbook that takes information from
all of the workbooks in a certain folder (C:\Folder\) and combines all
of the retrieved data into one cell on the workbook that collects the
data.

For instance, every workbook in the folder has a name in cell A1 (Bob,
Jim, Hank) which I want to combine in cell Al of the collecting book
(with a space or comma or line break... I am not sure yet).

So far I have this:

With Application.FileSearch
.NewSearch
.LookIn = "C:\Folder"
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
MsgBox "There were "& .FoundFiles.Count &" file(s) found."
For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
With ActiveWorkbook

*******
'take cell A1 from sheet1 and combine with the names
that are already in the collecting book to make a big list of names
*******
End With
Next i
Else
MsgBox "There were no files found"
End If
End With
End Sub


Obviously that is not working for me. I would very much appreciate a
solution to my current dilema.

Thanks in advance to anyone who can help,
Joe

 

[Dave Peterson]

Something like this????

Option Explicit

Sub testme()
Dim wkbk As Workbook
Dim consWks As Worksheet
Dim i As Long

Set consWks = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "C:\Folder"
.LookIn = "C:\my documents\excel\test"
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i))
consWks.Range("a1").Value _
= consWks.Range("a1").Value & ", " _
& wkbk.Worksheets("Sheet1").Range("a1").Value
wkbk.Close savechanges:=True
Next i
Else
MsgBox "There were no files found"
End If
End With
End Sub

(There's no validation that each of those workbooks has a worksheet named Sheet1
and that each sheet1 has something in A1!)

 

[Joe D]

Thank You Dave,

That does exactly what I want. However, it does somethings I don't want
as well:

1) I forgot about the fact that all of the workbooks that I open have
links in them that I need to keep, and for every workbook that gets
opened a dialog box asks me if I want to update them and I do want to
update them (well, actually it doesn't matter for my purposes).

2) I also forgot that they all have a userForm that automattically pops
up when each one is opened, and then I have to manually close each one.

How do I modify that code so that I don't have 80 different windows
bugging me each time I run it?

I have another question. When I explained my situation, I simplified
for clarity. I really need to reference cells J5 through J82, L5
through L82, and M5 through M82 and place them correspondingly in the
constant worksheet in H4:H81, I4:81, and J4:81. I tried adapting the
code for my purposes with no luck. What is the best way to do that?

Thanks,
Joe

 

[Dave Peterson]

I _think_ that this works:

Option Explicit
Sub testme()
Dim wkbk As Workbook
Dim consWks As Worksheet
Dim i As Long
Dim myCell As Range
Dim InputAddr As Variant
Dim OutputAddr As Variant
Dim CellCtr As Long
Dim AreaCtr As Long

InputAddr = Array("J5:J82", "L5:L82", "M5:M82")
OutputAddr = Array("H4", "I4", "J4")

Set consWks = ActiveSheet

With Application.FileSearch
.NewSearch
.LookIn = "C:\Folder"
.LookIn = "C:\my documents\excel\test"
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
MsgBox "There were " & .FoundFiles.Count & " file(s) found."
Application.EnableEvents = False
For i = 1 To .FoundFiles.Count
Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i), _
UpdateLinks:=0)
For AreaCtr = LBound(InputAddr) To UBound(InputAddr)
CellCtr = -1
For Each myCell In wkbk.Worksheets("sheet1") _
.Range(InputAddr(AreaCtr)).Cells
CellCtr = CellCtr + 1
consWks.Range(OutputAddr(AreaCtr)) _
.Offset(CellCtr, 0).Value _
= consWks.Range(OutputAddr(AreaCtr)) _
.Offset(CellCtr, 0).Value _
& myCell.Value
Next myCell
Next AreaCtr
wkbk.Close savechanges:=True
Next i
Application.EnableEvents = True
Else
MsgBox "There were no files found"
End If
End With
End Sub

Take a look at VBA's help for workbooks.open and you'll see what updatelinks:=0
means and to stop the workbook_open events, we just turn off .enableevents.

 

[Joe D]

Excellent, Thank you so much.