Get Cell Values from Other .xls files

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hello -

I need some conceptual help and some specific help.

I have many excel files being sent to me. All are in the same format :-)
I want to make a new .xls file (Master) that goes out into this directory
where all these .xls files are and "gets J2 and puts it in column A1 of the
Master workbook, then gets P4 and puts in in column B1 of the Master
workbook... when done, go get the next .xls, open and put in A2 and B2,
etc...".

I'm having difficulty finding what the objects are called and the syntax
that goes with them. Once I get a handle on this, I'll be able to ask better
questions to this group. until then -

Thank you VERY much!
 
Thank you, Ron.
I appreciate all your work putting these examples together.
I used you sample, made the adjustments, but I'm getting a:
Run-time error '1004' when I run within VB. If I run the macro outside VB I
get a 400 in the msgbox.

Could you tell me where I can learn more about error messages, what they
mean, how to fix them? I'm certain this is something simple, but I'm "dead in
the water".

I need to learn how to debug and fix my programs.
 
Hi DTTODGG

Where have you copy the code ?
When do you get the error ?
Show me the macro with your changes
 
Ron, I have gotten past the 1004 error (syntax in my GetOpenFilename line)
But, I don't get any of the cells - just the file name gets into column 1
and the other cells are yellow.

It seems to not like the line:
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , x1R1C1))

Can you explain what's here? what is Excel4Macro?

Thank you!
 
It works! Thank-you! Thank-you!

Now I have some fun things to work on during vacation!

Ron, how can I get labels or titles or names for the columns?

Also, is what code do I change so that it doesn't open a new file each time?
I would like to run this continually and keep appending my spreadsheet rather
than create a new one.

Cheers!
 
Change

Set SummWks = Workbooks.Add(1).Worksheets(1)
'Add a new workbook with one sheet for the Summary

To
Set SummWks = Sheets("yoursheetname)

You can clear the cells on this sheet (not row 1 with the headers) before you run the code
Or do you really want to add the new links below your other links each time ???
 
OK, this is getting fun! I wish I knew exactly how this stuff works, but I'm
learning.

How about this one?
When it opens the existing file, look for a duplicate in column B,
if a duplicate is found, add the new row, but color it blue, if not a
duplicate append the file as normal. This file will keep growing each month.

You see, I'm getting these forms(files) from sales each month. I want to
keep a running total of all the data. I might accidentally read the same file
twice, so I need to see that in blue - or if they sent an updated version of
that file, I can review the blue row to verify.

Does this make sense?

Also, what is ExecuteExcel4Macro?
 
Hi DTTODGG (I like your name<g>)

Test this one (don't forget to copy the function into the module)

Sub Summary_cells_from_Different_Workbooks()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim fndFileName As Range

ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
'Select the files with GetOpenFilename

If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set SummWks = Sheets("Sheet2")
'Use this sheet for the Summary

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = LastRow(SummWks) + 1

FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

Set fndFileName = Nothing
Set fndFileName = SummWks.Cells.Find(JustFileName)
If Not fndFileName Is Nothing Then
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbBlue
Else
'Do nothing
End If

SummWks.Cells(RwNum, 1).Value = JustFileName
'copy the workbook name in column A

PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
'build the formula string


On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))

If Err.Number <> 0 Then
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
'If the sheet name not exist in the workbook the row color will be Yellow.
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

SummWks.UsedRange.Columns.AutoFit
' Use AutoFit for setting the column width in the new workbook

MsgBox "The Summary is ready"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
BTW : Excel4Macro are macro's from older Excel versions that still work
in newer versions.
http://www.microsoft.com/downloads/...6b-7485-437a-819b-0f446f74ed81&DisplayLang=en

I use it to check the sheet name in a closed file and make the row yellow if it not exist



--
Regards Ron de Bruin
http://www.rondebruin.nl


Ron de Bruin said:
Hi DTTODGG (I like your name<g>)

Test this one (don't forget to copy the function into the module)

Sub Summary_cells_from_Different_Workbooks()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String
Dim fndFileName As Range

ShName = "Sheet1" '<---- Change
Set Rng = Range("A1,D5:E5,Z10") '<---- Change

FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)
'Select the files with GetOpenFilename

If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set SummWks = Sheets("Sheet2")
'Use this sheet for the Summary

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = LastRow(SummWks) + 1

FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

Set fndFileName = Nothing
Set fndFileName = SummWks.Cells.Find(JustFileName)
If Not fndFileName Is Nothing Then
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbBlue
Else
'Do nothing
End If

SummWks.Cells(RwNum, 1).Value = JustFileName
'copy the workbook name in column A

PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
'build the formula string


On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))

If Err.Number <> 0 Then
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
'If the sheet name not exist in the workbook the row color will be Yellow.
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

SummWks.UsedRange.Columns.AutoFit
' Use AutoFit for setting the column width in the new workbook

MsgBox "The Summary is ready"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
 
Back
Top