A loop which finds and matches more than one value - VBA

Storm8585

New Member
Joined
Sep 5, 2014
Messages
47
Hi all. I need help with some VBA using find and match type queries. I have a worksheet which has columns: ID, test depth and test result. I have a second worksheet which as ID, start depth, end depth and category. What I need the code to do is loop through each row in the first worksheet and check to find the ID in the second worksheet. Then see if the test result depth (the second col) for that row falls between the start depth and end depths (second and third cols in the other worksheet). If it matches the ID but the test depth isn’t between the two depths on that row, then it moves on to the next row. If it matches the ID and the test depth in between the values in col 2 and 3, then the code should return the category of that row (col 4) to col 3 of the first worksheet.
Sheet 1
ID
Test Depth
Test Result
VBA Response
BH1
0.75
6
Type A
BH1
3.8
1
Type B
BH1
1.11
25
Type A

<tbody>
</tbody>

Sheet 2
ID
Start Depth
End Depth
Category
BH1
0
1.45
Type A
BH1
1.45
4
Type B
BH1
4
5
Type C

<tbody>
</tbody>

Hope that’s clear. Thanks in advance!
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Hey

Try the below VBA code ... Just make sure to have a header in sheet1 column D before running the macro

Rich (BB code):
Sub FindCategory()
Dim Ar1 As Variant, Ar2 As Variant, Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Sheet1 ' make sure to change the sheet name
Set Ws2 = Sheet2 ' make sure to change the sheet name
Ar1 = Ws1.UsedRange.Value2
Ar2 = Ws2.UsedRange.Value2
For x = 2 To UBound(Ar1)
    For y = 2 To UBound(Ar2)
        If Ar1(x, 1) = Ar2(y, 1) And Ar1(x, 2) >= Ar2(y, 2) And Ar1(x, 2) <= Ar2(y, 3) Then
            Ar1(x, 4) = Ar2(y, 4)
            Exit For
        End If
    Next y
Next x
Ws1.Range("A1").Resize(UBound(Ar1), UBound(Ar1, 2)) = Ar1
End Sub
 
Upvote 0
Hi all. I need help with some VBA using find and match type queries. I have a worksheet which has columns: ID, test depth and test result. I have a second worksheet which as ID, start depth, end depth and category. What I need the code to do is loop through each row in the first worksheet and check to find the ID in the second worksheet. Then see if the test result depth (the second col) for that row falls between the start depth and end depths (second and third cols in the other worksheet). If it matches the ID but the test depth isn’t between the two depths on that row, then it moves on to the next row. If it matches the ID and the test depth in between the values in col 2 and 3, then the code should return the category of that row (col 4) to col 3 of the first worksheet.

According to your example, the result is in column 4.

Sheet 1
IDTest DepthTest ResultVBA Response
BH10.756Type A
BH13.81Type B
BH11.1125Type A

<tbody>
</tbody>

Sheet 2
IDStart DepthEnd DepthCategory
BH101.45Type A
BH11.454Type B
BH145Type C

<tbody>
</tbody>

Hope that’s clear. Thanks in advance!

Continuing with Peter's comment, if you fix the duplicate values ​​on sheet2, it can be with a formula:

<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:44.67px;" /><col style="width:94.1px;" /><col style="width:94.1px;" /><col style="width:94.1px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >ID</td><td >Test Depth</td><td >Test Result</td><td >VBA Response</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >BH1</td><td style="text-align:right; ">0.75</td><td > </td><td >Type A</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >BH1</td><td style="text-align:right; ">3.8</td><td > </td><td >Type B</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >BH1</td><td style="text-align:right; ">1.11</td><td > </td><td >Type A</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td >BH1</td><td style="text-align:right; ">4</td><td > </td><td >Type C</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td >BH1</td><td style="text-align:right; ">5</td><td > </td><td >Type C</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td >BH1</td><td style="text-align:right; ">6</td><td > </td><td >No Match</td></tr></table><br /><table style="font-family:Arial; font-size:10pt; border-style: groove ;border-color:#00ff00;background-color:#fffcf9; color:#000000; "><tr><td ><b></b></td></tr><tr><td ><table border = "1" cellspacing="0" cellpadding="2" style="font-family:Arial; font-size:9pt;"><tr style="background-color:#cacaca; font-size:10pt;"><td >Cell</td><td >Formula</td></tr><tr><td >D2</td><td >=IFERROR(INDEX(Sheet2!$D$2:$D$4,SUMPRODUCT((Sheet2!$A$2:$A$4=A2)*(Sheet2!$B$2:$B$4<=B2)*(Sheet2!$C$2:$C$4>=B2)*(ROW(Sheet2!$D$2:$D$4)))-1),"No Match")</td></tr></table></td></tr></table>

-----------------------------------


<b>Sheet2 With proposed values ​​to avoid the ambiguity of the values.</b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:76.04px;" /><col style="width:96px;" /><col style="width:96px;" /><col style="width:96px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td >ID</td><td >Start Depth</td><td >End Depth</td><td >Category</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td >BH1</td><td style="text-align:right; ">0</td><td style="text-align:right; ">1.45</td><td >Type A</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td >BH1</td><td style="text-align:right; ">1.46</td><td style="text-align:right; ">3.9</td><td >Type B</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td >BH1</td><td style="text-align:right; ">4</td><td style="text-align:right; ">5</td><td >Type C</td></tr></table>


----------------------------------

But if you also want the macro:

Code:
Sub Macro1()
  With Range("D2:D" & Range("A" & Rows.Count).End(xlUp).Row)
    .FormulaR1C1 = _
        "=IFERROR(INDEX(Sheet2!R2C4:R4C4,SUMPRODUCT((Sheet2!R2C1:R4C1=RC[-3])*(Sheet2!R2C2:R4C2<=RC[-2])*(Sheet2!R2C3:R4C3>=RC[-2])*(ROW(Sheet2!R2C4:R4C4)))-1),""No Match"")"
    .Value = .Value
  End With
End Sub
 
Upvote 0
All many thanks for the advise and solutions - I am very grateful for your help!
Glad you got a successful outcome but I would still be interested to know ..
- Whether you used formula or macro, and
-
What result would you want (& why) for BH1 and Depth 4?
I am asking this question because with your original sample data BH1, Depth 4 fits both of the last 2 rows in your sample Sheet2 meaning it could be Type B or Type C
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,215
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top