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").RefersToRange
Set LookUPRng2 = Workbooks("vendors2.xls").Names("AreaLU").RefersToRange
Set LookUPRng3 = Workbooks("vendors3.xls").Names("AreaLU").RefersToRange
Set LookUPRng4 = Workbooks("vendors4.xls").Names("AreaLU").RefersToRange
Set LookUPRng5 = Workbooks("vendors5.xls").Names("AreaLU").RefersToRange
Set LookUPRng6 = Workbooks("vendors6.xls").Names("AreaLU").RefersToRange
'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
