Excel VBA finding matching cell in another sheet in same book

Question

Basically this sheet works wonderfully with the exception of the find priority part... I need it to find the matching value inside the corresponding sheet, then return the row number it's in, so that I can paste values into the cell to the right of the found cell.

However, when I run this VBA (I have to comment it entirely out to keep from destroying the excel sheets entirely), the cells are 1 off and there are these randoms wound up in the bottom of the sheet (in "no man's land"). I have tried increasing and decreasing the value that holds the row identity to see if it would fix that part of my issue, but no such luck. Anyway, here's the code in it's broken fashion:

Private Sub Workbook_Open()
'connection to database
Dim userEmpId As String
Dim sSQL As String
userEmpId = InputBox(Prompt:="Employee ID.", Title:="ENTER EMPLOYEE ID", _
            Default:="A1JW7ZZ")
sSQL = "SELECT * FROM OP_TRAIN; "
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=I:\MANUFACTURING\Six Sigma Projects\Green Belt Projects 2012\Hebron Training Plan\3m hebron training.accdb;Persist Security Info=False"
Set rs = New ADODB.Recordset
rs.Open sSQL, cn
ActiveWorkbook.Sheets("Employee Training").Cells(1, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Worksheets("Employee Training").Activate
Dim Bottom As Integer
Dim CopyRange As String
Bottom = CInt(Cells(Rows.Count, "A").End(xlUp).Row) 'initializes the bottom of the list (total number of entries)
CopyRange = "A1:G" & Bottom 'Total data range

Do Until Bottom = 0 'loop until out of data
    ActiveSheet.Cells(Bottom, 1).Select 'selects column A of the current row
    If (Selection.Text <> userEmpId) Then
        Range(CopyRange).Rows(Bottom).Delete Shift:=xlUp
    End If
    Bottom = Bottom - 1
Loop
Bottom = CInt(Cells(Rows.Count, "A").End(xlUp).Row) 'initializes the bottom of the list (total number of entries)
Dim FoundRow As Integer
Do Until Bottom = 0 'loop until out of data
    'ActiveSheet.Cells(Bottom, 2).Select 'selects column B of the current row
    Select Case Selection.Text
        Case "1A"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP1A-OP1B").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "1B"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP1B-OP1C").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "1C"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP1C-OP2A").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "2A"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP2A-OP2B").Activate
            ' Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "2B"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP2B-OP2C").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "2C"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP2C-OP3A").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "3A"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP3A-OP3B").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "3B"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP3B-OP3C").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Case "3C"
            ActiveSheet.Cells(Bottom, 3).Select 'selects column C of the current row
            FoundRow = FindPriority(Selection.Value)
            'ActiveSheet.Cells(Bottom, 4).Select 'selects column D of the current row
            Selection.Copy
            Worksheets("OP3C-SOP").Activate
            Cells(FoundRow, 4).Select
            Selection.PasteSpecial Paste:=xlPasteValues, _
                  Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End Select
    Worksheets("Employee Training").Activate
    Bottom = Bottom - 1
Loop
End Sub

THIS IS THE PROBLEMATIC CODE

 Function FindPriority(priority As Integer) As Integer
 Dim ws As Excel.Worksheet
 Dim FoundCell As Excel.Range
 Set ws = ActiveSheet
 Set FoundCell = ws.Range("C:C").Find(what:=priority, lookat:=xlWhole)
 FindPriority = FoundCell.Row
 End Function

Answer 1

ActiveSheet.Range("C:C").Find(priority, , xlValues, xlWhole).Row

using the find function in conjunction to the row counter SOLVED MY ISSUE!!

Thanks Mike for pointing me in a better direction (in a sense I never would've dug deeper without you shining some light)

Answer 2

One thing you can try is the MATCH command. You access it in VBA as follows:

FindPriority = Application.WorksheetFunction.Match(priority,ws.Range("C:C"),0)

This will return the row number for you in your function.