PDA

View Full Version : [SOLVED] Search that loops through inputs



msmith
05-16-2005, 10:59 AM
Hello-
I need a search/find structure. I have an import sheet that has numerical values for certain samples. I also have a 'results' sheet. These are in different workbooks. I would like the search to take the samples names from the 'results' page (which are in a single column) and search for the corresponding numerical values from the import sheet. I have some code for the search but cannot get the loop to work. This code is pretty dirty since I am relatively new to vb so I'm sure it should be improved. I have included the base code.

Thanks in advance,
Mark



Dim qsearch As String
Dim Cel As Range
Dim temp2 As Variant
Dim temp1 As Variant
Dim FirstAddress As String
Dim n As Integer
For n = 69 To 110
With Range("B:B")
Windows("CForm.xls").Activate
qsearch = Sheets("Q").Range("L" & n).Value
Set Cel = .Find(What:=qsearch, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do
temp1 = Cel.Address
Windows(wbtemp).Activate 'import sheet
Range(temp1).Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=1).Activate
temp2 = ActiveCell.Value
Windows("CForm.xls").Activate
Sheets("Q").Select
Range("M" & n).Value = temp2
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
End If
End With
Next n

OBP
05-16-2005, 11:07 AM
Try moving the

While Not Cel Is Nothing And Cel.Address <> FirstAddress to the Do statement
so it is like this

Do While Not Cel Is Nothing And Cel.Address <> FirstAddress
vb code
Loop

msmith
05-16-2005, 11:19 AM
It doesn't seem to like that. It says End if block without if...

Bob Phillips
05-16-2005, 11:39 AM
It doesn't seem to like that. It says End if block without if...

Rgius is what is suggested


Dim qsearch As String
Dim Cel As Range
Dim temp2 As Variant
Dim temp1 As Variant
Dim FirstAddress As String
Dim n As Integer
For n = 69 To 110
With Range("B:B")
Windows("CForm.xls").Activate
qsearch = Sheets("Q").Range("L" & n).Value
Set Cel = .Find(What:=qsearch, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do While Not Cel Is Nothing And Cel.Address <> FirstAddress
temp1 = Cel.Address
Windows(wbtemp).Activate 'import sheet
Range(temp1).Activate
ActiveCell.Offset(rowOffset:=1, columnOffset:=1).Activate
temp2 = ActiveCell.Value
Windows("CForm.xls").Activate
Sheets("Q").Select
Range("M" & n).Value = temp2
Set Cel = .FindNext(Cel)
Loop
End If
End With
Next n


Cam't test properly as you don't set all the variables in this code

mdmackillop
05-16-2005, 11:50 AM
Range (B:B) is being reset to a range on CForm.xls Set your range first, such as


WBTemp = "WBT.xls"
Set SRange = Workbooks(WBTemp).Worksheets("sheet1").Range("B:B")
For n = 69 To 110
With SRange

This should work with your original code.

msmith
05-16-2005, 12:49 PM
Thanks. It works great now.



Range (B:B) is being reset to a range on CForm.xls Set your range first, such as

WBTemp = "WBT.xls"
Set SRange = Workbooks(WBTemp).Worksheets("sheet1").Range("B:B")

For n = 69 To 110
With SRange

This should work with your original code.

mdmackillop
05-16-2005, 12:53 PM
Glad to be of help. :thumb

mdmackillop
05-16-2005, 01:21 PM
Mark,
For a "cleaned up" version, have a look at the following. It avoids the sheet activations etc. and can be run from when either workbook is active.


Option Explicit
Sub test()
Dim qsearch As String
Dim Cel As Range
Dim FirstAddress As String
Dim n As Integer
Dim QSheet As Worksheet, SSheet As Worksheet
Dim SRange As Range
Set SSheet = Workbooks("WBT.xls").Sheets("Sheet1")
Set SRange = SSheet.Range("B:B")
Set QSheet = Workbooks("CForm.xls").Sheets("Q")
For n = 69 To 110
With SRange
qsearch = QSheet.Range("L" & n).Value
Set Cel = .Find(What:=qsearch, LookIn:=xlValues, _
LookAt:=xlWhole, MatchCase:=False)
If Not Cel Is Nothing Then
FirstAddress = Cel.Address
Do
QSheet.Range("M" & n).Value = SSheet.Range(Cel.Address).Offset(1, 1)
Set Cel = .FindNext(Cel)
Loop While Not Cel Is Nothing And Cel.Address <> FirstAddress
End If
End With
Next n
End

msmith
05-16-2005, 03:38 PM
Thanks again! That would speed up code later when the number of results increase on the import sheet.

Mark