how to: same cell, same form, same directory

[clacka]

I have a bunch of excel files in a folder called "Transfers"

They are all the same form (all of the same kind of data is in the same cells in all of the files).

I want to build one summary spreadsheet that will give me four columns:

1. The filename of each form in the directory
2. The data in cell A1 of the first worksheet (called "worksheet 1) of each form
3. The data in cell A2 of the first worksheet of each form
4 The data in cell A3 of the first worksheet of each form

I would rather not have to open each file, copy and paste the data into each cell, to create the collumns. Anyone know how to do this?
Alan

[theDude]

Alan,

It is possible with a macro, but I need a few more details:

1) Where do you want the data from each file placed in the summary sheet?
2) Would you like a hyperlink to the files from the summary sheet and which cell do you want the hyperlink created from (i.e. A1, A2, or A3 from the file in the Transfers folder)?

Just curious,
theDude

[clacka]

Hey Dude!

I would like the data to be arranged in columns with the filename as a hyperlink.

So there would be four columns. Column 1 would be the filename as a hyperlink, and then Column 2 would be the data in that file from cell a1 of the file, column 2 would be the data b1, and the third column would be the data from b3 of each file. Make sense?

Thanks Dude!
Alan

[theDude]

Alan,

Copy this macro to your summary sheet (change code in BOLD below to your references):

Sub addHyperLinkToFiles()
' Declare variables
Dim a(999999), i
Dim Msg, style, Title
Dim myDrive, myLocation, LoadDir As String
Dim counter, loopLimit
' Initialize variables...
' *** IMPORTANT *** Replace the drive name "C" below w/ your reference
myDrive = "C"
' *** IMPORTANT *** Replace the file path below w/ your reference
myLocation = "yourDirectory1\yourDirectory2\Transfers"

' Turn off screen updating (program runs faster)...
Application.ScreenUpdating = False

' Notify user of progress...
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Searching for files; please wait..."
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

'Set the filepath to the correct directory...
ChDrive myDrive
ChDir myDrive & ":\" & myLocation

' Initialize the array counter...
i = 0
' Load array with names of Excel files in correct directory...
a(i) = Dir("*.xls")
' If no Excel files are present, alert user & exit program...
If a(i) = "" Then
GoTo FilesMissing ' the error handler...
Exit Sub
Else
' Loop through the Excel files to count files as loop limit...
Do
i = i + 1
a(i) = Dir()
Loop Until a(i) = ""
' Count the number of names in the array...
fileCount = CStr(i)
' Notify user of number of files to be protected...
Application.StatusBar = "Number of files to process: " & fileCount & " - please wait..."
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
' Start looping through the Excel file(s) to open & process each one...
For MyFilCount = 0 To (fileCount - 1)
LoadDir = CurDir & "\"
Workbooks.Open LoadDir & (a(MyFilCount)), UpdateLinks:=0, _
ReadOnly:=False, IgnoreReadOnlyRecommended:=True
' Provide file processing status to user ...
Application.StatusBar = _
"Processing file " & MyFilCount + 1 & " of " & fileCount & ": " & a(MyFilCount) & "; please wait..."
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

' Add filename hyperlink & related data...
fileName = ActiveWorkbook.Name
Worksheets("worksheet 1").Activate
val1 = ActiveSheet.Range("A1").Value
val2 = ActiveSheet.Range("B1").Value
val3 = ActiveSheet.Range("B3").Value
ActiveWorkbook.Close SaveChanges:=False
ActiveSheet.Range("A1").Select
Do Until IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = fileName
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=LoadDir & (a(MyFilCount)) _
, TextToDisplay:=fileName
ActiveCell.Offset(0, 1).Value = val1
ActiveCell.Offset(0, 2).Value = val2
ActiveCell.Offset(0, 3).Value = val3
Next MyFilCount
' Reset screen updating and status bar...
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
' Define user dialog parameters
Msg = "File processing is now complete."
style = vbOKOnly + vbInformation + vbDefaultButton1
Title = "File Processing Status"
' Display user dialog
Response = MsgBox(Msg, style, Title)
End If
Exit Sub
'Error handler if no file(s) exist in directory...
FilesMissing:
' Define user dialog parameters
Msg = "There are no files located in the " & myDrive & ":\" & myLocation & " directory." & Chr(13) & _
"The program stopped and no updates were made."
style = vbOKOnly + vbCritical + vbDefaultButton1
Title = "Missing File(s)"
' Display user dialog
Response = MsgBox(Msg, style, Title)
' Reset screen updating and status bar...
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
End Sub


Hope this helps,
theDude

[clacka]

Wow! Dude! It worked like a charm!

Thanks so much!