View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Mike H. Mike H. is offline
external usenet poster
 
Posts: 471
Default Multiple lookup?

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