Please help...This is turning into a nightmare
Posted by Justin on November 08, 2001 1:33 AM
I am creating a database of infomation files that have been created using a purpose built excel 97 template. In order to do this I output a directory list, where all the files are, to a text file- call the file into column A in excel and run the following formula next to it
Root = C:\x
File = abc.xls [from directory list]
Cell reference = Payrate
Linking Formula = =""&"="&"'"&root&"\"&file&"'"&"!"&cell reference
The result is ""='c:\x\abc.xls'!payrate. I then run a replace command to find ""=' and replace it with ='c.
Two problems concern me with this method.
1. there must be an easier way...HELP (there are 4000 files to pull, 10 different cell references on each)
2. If there isn't an easier way, how do I turn off the 'dead link' message when a file is corrupted or does not have that reference. This is what slows my method down
Posted by Robb on November 08, 2001 4:34 AM
Justin
Try this code. It assumes a list of file names in column(a) in the activeworkbook and pulls tha value
of the named range from each file to the cell in column(B) - next to the file name.
If the file is not there, it will simply insert "No File" and if the named range does not exist in the file,
you should get #NAME? in Column(B). You could amend the code if you wanted to retrieve more than one range
value.
Just paste this code in a module and run "getCallCell".
Private Function CallCell(root, file, ref)
Dim arg As String
'Test file exists
If Right(root, 1) <> "\" Then root = root & "\"
If Dir(root & file) = "" Then
CallCell = "No file"
Exit Function
End If
arg = "'" & root & file & "'!" & ref
CallCell = ExecuteExcel4Macro(arg)
End Function
Sub getCallCell()
root = "C:\x"
ref = "Payrate"
With ThisWorkbook.Worksheets("Sheet1").UsedRange
For Each c In Columns(1).Cells
If c.Value = "" Then GoTo Skip
file = c.Value
c.Offset(0, 1) = CallCell(root, file, ref)
Skip:
Next c
End With
End Sub
Does this help?
Regards
Robb
Posted by justin on November 16, 2001 5:56 AM
Rob
Many thanks it works like gem!!
regards,
Justin
