Help on Search

[B]

Using Excel2000, if someone can help me with a sample code as a starter to
do the steps below. But first, I have a main working file that lists all
inventory items with catalog numbers, qty and price.

This is what needs to be done:
1) search an ID from a separate file (SearchFile1) based in user input while
on main file. If found, copy the price into the main working file.
2) If the ID is not found on SearchFile1, then search another file
(SearchFile2). Again, if found, copy the price into the main working file
3)...the file search is up to 5 files and all have multiple worksheets.

TIA!
Bob

 

[Tom Ogilvy]

Dim varr as Variant
Dim IdNumber as String
Dim i as Long
Dim rng as range, rng1 as Range
Dim bk as Workbook
Dim sh as Worksheet
Dim lngId as Long
varr = Array("SearchFile1","SearchFile2","SearchFile3", _
"SearchFile4","SearchFile5")
IdNumber = Inputbox("IdNumber: ")
if IdNumber <> "" then
for i = lbound(varr) to ubound(varr)
set bk = Workbooks(varr(i) & ".xls")
for each sh in bk.Worksheets
if isnumeric(IdNumber) then
lngId = clng(IdNumber)
set rng = sh.Cells.Find(lngId)
else
set rng = sh.Cells.Find(lngID)
end if
if not rng is nothing then
if isnumeric(IdNumber) then
lngId = clng(IdNumber)
set rng1= thisworkbook.Worksheets(1).Range("A:A") _
.Find(lngId)
else
set rng1 = ThisWorkbook.Worksheets(1).Rnage("A:A") _
.find(IdNumber)
end if
if not rng1 is nothing then
rng1.offset(0,1).Value = rng.offset(0,1).Value
exit sub
Else
msgbox "Master doesn't have " & idNumber
Exit Sub
end if
End if
Next sh
Next i
msgbox idNumber & " was not found"

the above pseudo code may help you get started.

 

[B]

Thank you for the code snippet, below is the modified version and now I am
stuck with a couple of issues.

1) I can't get the code to look for multiple entries of the same "IdNumber"
and populate corresponding price.
If run, it successfully capture the price, but there are instances where the
"IdNumber" exists on several entries on same cell (column E)

2) searchfile1 and searchfile2 should remain to be closed when the macro
searches for the IdNumber. For some reason the code leaves them open.

Below is the update code, pls advise how to change based from above issues.
Thanks again!
Bob


Dim varr As Variant
Dim IdNumber As String, strItem As String
Dim i As Long
Dim rng As Range, rng1 As Range
Dim bk As Workbook
Dim sh As Worksheet
Dim lngId As Long
Dim X As Single


varr = Array("file1", "file2")
IdNumber = InputBox("IdNumber: ")

If IdNumber <> "" Then
For i = LBound(varr) To UBound(varr)
Set bk = Workbooks.Open(Filename:="e:\Filefolder\" & varr(i) & ".xls")
For Each sh In bk.Worksheets
Set rng = sh.Cells.Find(What:=IdNumber & "*")
If Not rng Is Nothing Then
Set rng1 = ThisWorkbook.Worksheets(1).Range("A:Z").Find(IdNumber
& "*")
If Not rng1 Is Nothing Then

For Each cell In
ThisWorkbook.Worksheets(1).Range("E:E").Find(IdNumber & "*")
If rng1.Offset(0, 1).Value = 0 Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
ElseIf rng1.Offset(0, 1).Value = "" Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
Else
Exit Sub
End If
Next cell

Else
MsgBox "Master doesn't have " & IdNumber
Exit Sub
End If
End If
Next sh
Next i
MsgBox IdNumber & " was not found"
End If

 

[Tom Ogilvy]

If there are several entries for the same IDNumber, which price do you want
to use?

I added code to close the workbooks.


Dim varr As Variant
Dim IdNumber As String, strItem As String
Dim i As Long
Dim rng As Range, rng1 As Range
Dim bk As Workbook
Dim sh As Worksheet
Dim lngId As Long
Dim X As Single


varr = Array("file1", "file2")
IdNumber = InputBox("IdNumber: ")

If IdNumber <> "" Then
For i = LBound(varr) To UBound(varr)
Set bk = Workbooks.Open(Filename:="e:\Filefolder\" & varr(i) & ".xls")
For Each sh In bk.Worksheets
Set rng = sh.Cells.Find(What:=IdNumber & "*")
If Not rng Is Nothing Then
Set rng1 = ThisWorkbook.Worksheets(1).Range("A:Z").Find(IdNumber
& "*")
If Not rng1 Is Nothing Then

For Each cell In
ThisWorkbook.Worksheets(1).Range("E:E").Find(IdNumber & "*")
If rng1.Offset(0, 1).Value = 0 Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
ElseIf rng1.Offset(0, 1).Value = "" Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
Else
Exit Sub
End If
Next cell

Else
MsgBox "Master doesn't have " & IdNumber
Exit Sub
End If
End If
Next sh
Bk.close SaveChanges:=False
Next i
MsgBox IdNumber & " was not found"
End If

 

[B]

They're all the same price, even if multiple instances of the same IdNumber
was found.

Many thanks!

 

[Tom Ogilvy]

I am not sure why you search A:Z if the ID is only in E, but perhaps you can
modify the below to do what you want. (it is untested and may contain
typos).


Dim varr As Variant
Dim IdNumber As String, strItem As String
Dim i As Long
Dim rng As Range, rng1 As Range
Dim rngA as Range, rng2 as Range, rng3 as Range
Dim fAddr as String
Dim bk As Workbook
Dim sh As Worksheet
Dim lngId As Long
Dim X As Single


varr = Array("file1", "file2")
IdNumber = InputBox("IdNumber: ")

If IdNumber <> "" Then
For i = LBound(varr) To UBound(varr)
Set bk = Workbooks.Open(Filename:="e:\Filefolder\" & varr(i) & ".xls")
For Each sh In bk.Worksheets
Set rng = sh.Cells.Find(What:=IdNumber & "*")
If Not rng Is Nothing Then
set rngA = ThisWorkbook.Worksheets(1).Range("A:Z")
Set rng1 = rngA.Find(IdNumber & "*")
If Not rng1 Is Nothing Then
fAddr = rng1.Address
Do
if rng2 is nothing then
set rng2 = rng1
else
set rng2 = union(rng2,rng1)
end if
set rng1 = rngA.FindNext(rng1)
Loop while rng1.Address <> fAddr
set rng3 = ThisWorkbook.Worksheets(1).Range("E:E")
set rng3 = Intersect(rng2, rng3)
if not rng3 is nothing then
For Each rng1 In rng3
If rng1.Offset(0, 1).Value = 0 Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
ElseIf rng1.Offset(0, 1).Value = "" Then
rng1.Offset(0, 1).Value = rng.Offset(0, 8).Value
Exit Sub
Else
Exit Sub
End If
Next rng1
End If
Else
MsgBox "Master doesn't have " & IdNumber
Exit Sub
End If
End If
Next sh
Next i
MsgBox IdNumber & " was not found"
End If