VBA Index Match with a loop with two conditions - excel

Question

I hope that someone could help me with an index match formula that is made using a loop and storing the results data on the column.
Let's say that my data is following to make it simple:
We have an employee column and a salary column. I want to find all the salary options for HR employees.
I would like to store automatically all the results found on the column J (Researched input is in column I). And I want to finish the loop after not finding any new values.
Here is the data:
My initial code is down below without a loop to go down on the range:
Sub test()
Dim oCell As Range
Dim i As Long
i = 1
Do While Worksheets("Sheet1").Cells(i, 9).Value <> ""
Set oCell = Worksheets("Sheet1").Range("A:A").Find(What:=Worksheets("Sheet1").Cells(i, 9))
If Not oCell Is Nothing Then Worksheets("Sheet1").Cells(i, 10) = oCell.Offset(0, 1)
i = i + 1
Loop
End Sub

Answer 1

The problem stems from two main things:
The .Find range you are searching is the entire column A, which is then set to a .Range object (oCell). However, from my VBA understanding the .Find method cannot apply the cell address of each instance of the string/search parameter you are looking for. It will only apply the cell address of the first one it finds. To set a .Range object of non-contiguous rows you could use UNION function.
The .Find(What:= ... is set to a dynamic range which moves down column I as the loop continues. This means it will never find a match because it is searching the preceding column.
Here is a suggested solution, which hopefully you can adapt to your real world data:
Option Explicit
'
Sub test()
Dim oCell As Range
Dim i As Long
i = 1
Do While Worksheets("Sheet1").Cells(i, 2).Value <> ""
' Included as a sense check when stepping through your code to confirm loop is on correct cell
'Debug.Print Cells(i, 2).Address
'Debug.Print Cells(i, 2).Value
'Debug.Print "NEXT"
Set oCell = Worksheets("Sheet1").Range("A1:A10").Find(What:="HR")
If Not oCell Is Nothing Then Worksheets("Sheet1").Cells(i, 3) = oCell.Offset(0, 1)
i = i + 1
Loop
End Sub

Answer 2

Try this:
Option Explicit
Sub test()
Dim i As Long
Dim wb as Excel.Workbook
Dim ws as Excel.Worksheet
i = 2 ' we don't need the header
set wb = ActiveWorkBook
set ws = wb.Sheets("Sheet1") ' or wb.Sheets(1)
Do While ws.Cells(i, 1) <> ""
If ws.Cells(i,1) = "HR" then
ws.Cells(i, 3) = ws.Cells(i,2)
End If
i = i + 1
Loop
End Sub
Tested and found working