title: Excel VBA finding matching cell in another sheet in same book
body: <p>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.</p>
  
  <p>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:</p>
  
  <pre><code>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" &amp; 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 &lt;&gt; 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
  </code></pre>
  
  <p>THIS IS THE PROBLEMATIC CODE</p>
  
  <pre><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
  </code></pre>