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