Search that loops through inputs

[msmith]

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]

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]

It doesn't seem to like that. It says End if block without if...

[Bob Phillips]

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]

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]

Thanks. It works great now.

Range (B:B) is being reset to a range on CForm.xls Set your range first, such as
[VBA]
WBTemp = "WBT.xls"
Set SRange = Workbooks(WBTemp).Worksheets("sheet1").Range("B:B")

For n = 69 To 110
With SRange
[/VBA]
This should work with your original code.

[mdmackillop]

Glad to be of help.

[mdmackillop]

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]

Thanks again! That would speed up code later when the number of results increase on the import sheet.

Mark