Hello,

I am looking for a helpful solution through VBA.

I need to collect data from multiple WB's (found in same locations
ex(a1:b100) from up to 6 multiple xls files (all files are in same location
(folder)).

example:
Folder_DATA(Vendor1.xls, Vendor2.xls, Vendor3.xls...)

Vendor1.xls contains:
A B
1 Part # Amount($)
2
3

BOM.xls contains a summary to summize cost by part #:

A(Part #) J(Vendor1.xls) K(Vendor2.xls) L(Vendor3.xls)

1 12345678 $400.00 $500.00 $450.00
2 23456789 $325.00 $525.00 $625.00

BOM.xls already contains the part#'s. I only want the cost$ data for each
part # from each WB. This is a challenge for the basic guy like me. Can this
be done via a command button?

First I am assuming that the part # will only appear one time in the
vendor1.xls, vendor2.xls, etc files. If that is not the
case, this will not work (I have other ideas, so let me know).
Should you need help assigning the code to a button and can't find it on
this site, let me know. But here is code that would work under this senario:

Sub GetCosts()
Dim PartNo as String
Dim FilePath as String
Dim x as double
Dim MyBook as String
Dim LookupRng1 as Range
Dim LookupRng2 as Range
Dim LookupRng3 as Range
Dim LookupRng4 as Range
Dim LookupRng5 as Range
Dim LookupRng6 as Range
Dim Value1 as Double
Dim Value2 as Double
Dim Value3 as Double
Dim Value4 as Double
Dim Value5 as Double
Dim Value6 as Double
Dim TheRow as Double


MyWB = ActiveWorkbook.Name

let Filepath="c:\temp\" 'you need to put your path here!



for x=1 to 6
Let Isopen = IsOpenWB(CashierFile)
If Isopen < True Then
Workbooks.Open Filename:=FilePath & "Vendor" & x
End If
Windows("vendor" & x).Activate
If ActiveWorkbook.ReadOnly Then
Else
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
'I make it read-only since others may be needing it and I am not
writing to it so I just have it read-only
End If
next
Windows(MyWB).Activate



Set LookUPRng1 = Workbooks("vendors1.xls").Names("AreaLU").RefersTo Range
Set LookUPRng2 = Workbooks("vendors2.xls").Names("AreaLU").RefersTo Range
Set LookUPRng3 = Workbooks("vendors3.xls").Names("AreaLU").RefersTo Range
Set LookUPRng4 = Workbooks("vendors4.xls").Names("AreaLU").RefersTo Range
Set LookUPRng5 = Workbooks("vendors5.xls").Names("AreaLU").RefersTo Range
Set LookUPRng6 = Workbooks("vendors6.xls").Names("AreaLU").RefersTo Range
'The above lines depend on a named range "arealu" being defined in the
spreadsheets. I don't know how to do it otherwise



Windows(MyWb).Activate
cells(1,1).select
Let TheRow=activecell.row


Do While True
if cells(TheRow,1).value="" then
exit Do
end if
let PartNo=cells(TheRow,1).value
On Error Resume Next

Let Value1 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng1, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value1=0
end if

Let Value2 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng2, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value2=0
end if
Let Value3 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng3, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value3=0
end if
Let Value4 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng4, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value4=0
end if
Let Value5 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng5, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value5=0
end if
Let Value6 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng6, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value6=0
end if


cells(TheRow,10).value=value1
cells(TheRow,11).value=value2
cells(TheRow,12).value=value3
cells(TheRow,13).value=value4
cells(TheRow,14).value=value5
cells(TheRow,15).value=value6

let TheRow=TheRow+1
Loop



End Sub


Public Function IsOpenWB(ByVal WBname As String) As Boolean
'returns true if workbook is open
Dim objWorkbook As Object
On Error Resume Next
IsOpenWB = False
Set objWorkbook = Workbooks(WBname)
If Err = 0 Then IsOpenWB = True
End Function

Thanks for the help,

Couple of things (my ignorance!).
1st. You are correct on assuming the part number shows only once per WB.

2nd. Can I, instead of naming the path in the code, open the "file open"
dialog window and go get the exact files I want to take the data from?

3rd. I get an error with this line:
Set LookupRng1 = Workbooks("vendors1.xls").Names("areaLu").RefersTo Range

The row B starting at B96 to B??? has the part numbers in it
The row C starting at C96 to C??? has the cost associated to B#

How would that read for the range? ("B96:C125") (i tried this and it also
errored.)

Thanks for the help.

"Mike H." wrote:

First I am assuming that the part # will only appear one time in the
vendor1.xls, vendor2.xls, etc files. If that is not the
case, this will not work (I have other ideas, so let me know).
Should you need help assigning the code to a button and can't find it on
this site, let me know. But here is code that would work under this senario:

Sub GetCosts()
Dim PartNo as String
Dim FilePath as String
Dim x as double
Dim MyBook as String
Dim LookupRng1 as Range
Dim LookupRng2 as Range
Dim LookupRng3 as Range
Dim LookupRng4 as Range
Dim LookupRng5 as Range
Dim LookupRng6 as Range
Dim Value1 as Double
Dim Value2 as Double
Dim Value3 as Double
Dim Value4 as Double
Dim Value5 as Double
Dim Value6 as Double
Dim TheRow as Double


MyWB = ActiveWorkbook.Name

let Filepath="c:\temp\" 'you need to put your path here!



for x=1 to 6
Let Isopen = IsOpenWB(CashierFile)
If Isopen < True Then
Workbooks.Open Filename:=FilePath & "Vendor" & x
End If
Windows("vendor" & x).Activate
If ActiveWorkbook.ReadOnly Then
Else
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
'I make it read-only since others may be needing it and I am not
writing to it so I just have it read-only
End If
next
Windows(MyWB).Activate



Set LookUPRng1 = Workbooks("vendors1.xls").Names("AreaLU").RefersTo Range
Set LookUPRng2 = Workbooks("vendors2.xls").Names("AreaLU").RefersTo Range
Set LookUPRng3 = Workbooks("vendors3.xls").Names("AreaLU").RefersTo Range
Set LookUPRng4 = Workbooks("vendors4.xls").Names("AreaLU").RefersTo Range
Set LookUPRng5 = Workbooks("vendors5.xls").Names("AreaLU").RefersTo Range
Set LookUPRng6 = Workbooks("vendors6.xls").Names("AreaLU").RefersTo Range
'The above lines depend on a named range "arealu" being defined in the
spreadsheets. I don't know how to do it otherwise



Windows(MyWb).Activate
cells(1,1).select
Let TheRow=activecell.row


Do While True
if cells(TheRow,1).value="" then
exit Do
end if
let PartNo=cells(TheRow,1).value
On Error Resume Next

Let Value1 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng1, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value1=0
end if

Let Value2 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng2, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value2=0
end if
Let Value3 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng3, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value3=0
end if
Let Value4 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng4, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value4=0
end if
Let Value5 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng5, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value5=0
end if
Let Value6 = Application.WorksheetFunction.VLookup(PartNo, LookUPRng6, 2,
False)
If Err.Number < 0 Then
'an error occurred
let value6=0
end if


cells(TheRow,10).value=value1
cells(TheRow,11).value=value2
cells(TheRow,12).value=value3
cells(TheRow,13).value=value4
cells(TheRow,14).value=value5
cells(TheRow,15).value=value6

let TheRow=TheRow+1
Loop



End Sub


Public Function IsOpenWB(ByVal WBname As String) As Boolean
'returns true if workbook is open
Dim objWorkbook As Object
On Error Resume Next
IsOpenWB = False
Set objWorkbook = Workbooks(WBname)
If Err = 0 Then IsOpenWB = True
End Function

#3. The error is probably because you didn't name the range. If you go to
vendor1.xls and select (highlight) the area where the first col is part# and
second col is cost. (I would extend the area down below the area where data
is to allow for additions). Then select the menu as follows:
InsertNameDefine and then type AreaLU. This will define that area that
you highlighted as the named range "arealu". You'd need to do the same for
the other vendorX.xls files too.

#2. Not sure why you'd want to do this. I thought the files were all in
the same path and were always named vendor1.xls, vendor2.xls....vendor6.xls.
So I don't understand why you'd want to go to the trouble of manually opening
them if they are always the same. But you could do that, but you might get
errors if the files were not all opened.

This command will allow you to turn the path into a variable. Have you
initial file open and then add this line instead of the one below:

Use this:
let FilePath=ThisWorkbook.Path

Instead of this one:
let Filepath="c:\temp\" 'you need to put your path here!

Mike,

Maybe you can assist or direct the next issue I am having, the network
location! and people placing the files in a repetative place and naming
convention. The BOM directory will have many sub directories and from within
there will be the vendor forms. The structure is alway the same, but the file
names may differ by vendor or operator.

Can I call a dialog box (file open) and go get the vendor forms (regardless
of the names)? there may only be 1 or upto 6

"Mike H." wrote:

This command will allow you to turn the path into a variable. Have you
initial file open and then add this line instead of the one below:

Use this:
let FilePath=ThisWorkbook.Path

Instead of this one:
let Filepath="c:\temp\" 'you need to put your path here!

Windows("vendor" & x).Activate

error message!! is giving me "subscript out of range"

"Mike H." wrote:

This command will allow you to turn the path into a variable. Have you
initial file open and then add this line instead of the one below:

Use this:
let FilePath=ThisWorkbook.Path

Instead of this one:
let Filepath="c:\temp\" 'you need to put your path here!

The error will NOT come up if the file is already active in memory. The code
has the isopenwb() function called before you got to the activate statement.
The error is because the file is not in memory. I am not sure why that would
be because the isopenwb() function should have it loaded.

"Kip" wrote:

Windows("vendor" & x).Activate

error message!! is giving me "subscript out of range"

"Mike H." wrote:

This command will allow you to turn the path into a variable. Have you
initial file open and then add this line instead of the one below:

Use this:
let FilePath=ThisWorkbook.Path

Instead of this one:
let Filepath="c:\temp\" 'you need to put your path here!

I am not following what you are saying here exactly. Is it that each file
will have sub-directories where the vendor1.. up to vendor6 will be located?
If that is the case, you could use this to find your files: (see more notes
after the code)

Private Sub ListAllFilesInDirectoryStructure()
Dim Counter As Integer
Dim FileDir2 As String
Dim FileDir3 As String
Dim FileDir4 As String
Dim Y As Integer
Dim X As Integer
Dim MN As Variant
Dim Dy As Variant
Dim tmp As String
Dim Flee As String
Let Dy = Day(Dt)



Sheets("Control").Select 'have a sheet named control where you can place
the files in.
Application.Goto reference:="FileDir" 'have a named range fieldir where
you store the top-directory path location (get this from the
thisworkbook.path when you have the top file being your bom file.
FileDir = ActiveCell.Value

iFile = 0
ListFilesInDirectory FileDir, 1 ' change the top level as you wish
Application.Goto reference:="FilesToDo" 'have a named range so you can
record the results....
X = ActiveCell.Row
X = X + 1


'This solution lists files within all directories:
For Counter = 1 To iFile
Flee = FileFromPath(aFiles(Counter))
If LCase(Right(Flee, 3)) = "xls" Then 'list only .xls files....
Cells(X, 1).Select
ActiveCell.Value = aFiles(Counter)
X = X + 1
End If
Next



End Sub


Private Sub ListFilesInDirectory(Directory As String, EraseIt As Integer)
'This is called by the list all files function above.
Dim X As Integer, Y As Integer
Dim aDirs() As String, iDir As Integer, stFile As String



' use Dir function to find files and directories in Directory
' look for directories and build a separate array of them
' note that Dir returns files as well as directories when vbDirectory
' specified

If EraseIt = 1 Then
Sheets("Control").Select
Application.Goto reference:="FilesToDo"
X = ActiveCell.Row
Do While Len(ActiveCell.Value) 0
If ActiveCell.Value < "FilesToDo" Then
ActiveCell.Clear
End If
X = X + 1
Cells(X, 1).Select
Loop
End If


iDir = 0
stFile = Directory & Dir(Directory & "*.*", vbDirectory)
Do While stFile < Directory
If Right(stFile, 2) = "\." Or Right(stFile, 3) = "\.." Then
' do nothing - GetAttr doesn't like these directories
ElseIf GetAttr(stFile) = vbDirectory Then
' add to local array of directories
iDir = iDir + 1
ReDim Preserve aDirs(iDir)
aDirs(iDir) = stFile
Else
' add to global array of files
iFile = iFile + 1
ReDim Preserve aFiles(iFile)
aFiles(iFile) = stFile
End If
stFile = Directory & Dir()
Loop

' now, for any directories in aDirs call self recursively
If iDir 0 Then
For iDir = 1 To UBound(aDirs)
ListFilesInDirectory aDirs(iDir) & Application.PathSeparator, 0
Next iDir
End If


End Sub


Then you could just go through the files listed in the filestodo listing and
open the ones that are named vendorx.xls.

Let me know if this makes sense.

Thanks you've been a great help.


"Mike H." wrote:

The error will NOT come up if the file is already active in memory. The code
has the isopenwb() function called before you got to the activate statement.
The error is because the file is not in memory. I am not sure why that would
be because the isopenwb() function should have it loaded.

"Kip" wrote:

Windows("vendor" & x).Activate

error message!! is giving me "subscript out of range"

"Mike H." wrote:

This command will allow you to turn the path into a variable. Have you
initial file open and then add this line instead of the one below:

Use this:
let FilePath=ThisWorkbook.Path

Instead of this one:
let Filepath="c:\temp\" 'you need to put your path here!