HELP I need code that will locate duplicate text

[riosaaron]

Greetings friends,
I have limited excel knowledge and experience, yet despite that, through the painstaking process of searching online forums such as this one, i have managed to create a "Employee Punch in/out" userform. So far i am happy with it.

Here is how it works:
A employee types in his Last Name in textbox1, then his First in textbox2.
Then the employee clicks the command Button

this causes his last name, first name, date and tme to populate an excel spread sheet by row-
(i've managed to create and attach the VBA coding for time and date to automatically generate for this and it works Great)

Here is my problem:
for the employee to punch "out", i need code for excell to identify the employee by his last name in column " a" and first name in column "b" and not simply populate another row that way the OUT time populates in the same row as the in time.

here is my coding so far:

Private Sub CommandButton1_Click() 
Dim iRow As Long 
Dim ws As Worksheet 
Set ws = Worksheets("sheet1") 

'find first empty row in database 
iRow = ws.Cells(Rows.Count, 1) _ 
  .End(xlUp).Offset(1, 0).Row 

'check for a part number 
If Trim(Me.TextBox1.Value) = "" Then 
  Me.TextBox1.SetFocus 
  MsgBox "Please enter Required Information" 
  Exit Sub 
End If 
If Trim(Me.TextBox2.Value) = "" Then 
  Me.TextBox2.SetFocus 
  MsgBox "Please enter Required Information" 
  Exit Sub 
End If 

'copy the data to the database 
ws.Cells(iRow, 1).Value = Me.TextBox1.Value 
ws.Cells(iRow, 2).Value = Me.TextBox2.Value 

ws.Cells(iRow, 3).Value = Date 
ws.Cells(iRow, 4).Value = Time() 

'clear the data 
Me.TextBox1.Value = "" 
Me.TextBox2.Value = "" 





End Sub 

Private Sub CommandButton2_Click() 
Dim iRow As Long 
Dim ws As Worksheet 
Set ws = Worksheets("sheet1") 



'find first empty row in database 
iRow = ws.Cells(Rows.Count, 1) _ 
  .End(xlUp).Offset(0).Row 


If Trim(Me.TextBox1.Value) = "" Then 
  Me.TextBox1.SetFocus 
  MsgBox "Please enter Required Information" 
  Exit Sub 
End If 
If Trim(Me.TextBox2.Value) = "" Then 
  Me.TextBox2.SetFocus 
  MsgBox "Please enter Required Information" 
  Exit Sub 
End If 

'clear the data 
Me.TextBox1.Value = "" 
Me.TextBox2.Value = "" 


ws.Cells(iRow, 5).Value = Time() 
End Sub  

[IMG]http://www.excelforum.com/images/styles/Skylight/misc/progress.gif[/IMG]

</DIV><!-- BEGIN TEMPLATE: bbcode_php -->

 

[Ralajer]

Welcome to the board riosaaron,

The below is function will return the first row number that a pair of strings are found in there specified ranges.

Function RowFromPair( _
                Pair_1_Str As String, _
                Pair_2_Str As String, _
                Pair_1_Rng As Range, _
                Pair_2_Rng As Range) As Long

    Dim foundRng As Range
    Dim firstFound As Long
    Dim Pair_1_StrRow As Long
    Dim Offset1to2 As Integer
    
    '// Default return
    RowFromPair = -1
    
    '// Offset from item 1 to 2
    Offset1to2 = Pair_2_Rng.Column - Pair_1_Rng.Column
    
    On Error Resume Next
    
    Set foundRng = Pair_1_Rng.Find(What:=Pair_1_Str, After:=Pair_1_Rng.Cells(1, 1))
    
    If foundRng Is Nothing Then
        GoTo earlyExit
    End If
    
    If foundRng.Offset(0, Offset1to2).Value = Pair_2_Str Then
        RowFromPair = foundRng.Row
        GoTo earlyExit
    End If
    
    firstFound = foundRng.Row
    
    Do While True
        Set foundRng = Pair_1_Rng.FindNext(foundRng)

        If foundRng Is Nothing Then GoTo earlyExit
        If foundRng.Row = firstFound Then GoTo earlyExit
        
        
        If foundRng.Offset(0, Offset1to2).Value = Pair_2_Str Then
            RowFromPair = foundRng.Row
            Exit Do
        End If
    Loop
    On Error GoTo 0

earlyExit:

End Function

It is called like this.

Dim EmployeeRow As Long

EmployeeRow = RowFromPair(Me.TextBox1.Value , Me.TextBox2.Value , ws.Range("A:A"), ws.Range("B:B"))

If EmployeeRow = -1 then msgbox "Name not found"

Then use that row to determine where to place the time date info. It returns -1 if the pair isn't found.

 

[riosaaron]

Thank you for your post;
I appologize- despite what i managed to make, i am still novice at this. The Code you provided, is it intended to be cut and pasted, or is it in addition my existing code?

 

[Ralajer]

The the function is in addition to but not inside your code and it gets called from your button click sub so the code from the bottom code section would have to integrated in. I could help you with that but I am unclear on few things. Do you want just one check IN and OUT for on the sheet for each employee or do need it create a new row once an employee has already check in and out? Where are the date and time output, Col A & B are the names, is the output for check IN C & D check OUT E & F?

Thanks

 

[riosaaron]

here is the actual form-
http://www.excelforum.com/misc.php?do=showattachments&t=781551

the "User Form" has 2 text boxes and two command boxes

txtbox 1 is last name
txtbox 2 is first name

command button 1 submits the data from txtbox 1 and txtbox 2 to the first empty cells in a row available. In addition, it also populates the cells in the same row with "date" followed by "TIME IN", the last cell in the row is reserved for "TIME OUT"

The code currently specifies that command button 1 place the information in the first empty row-available-once data is input, it automatically moves to the next row.

What i specifically need is:
when someone types their Last name and First name in the Userform to punch "OUT" -i need commandbutton2 to submit the OUT TIME to the same row in the cell NEXT to the "In Time"

i apologize if i have confused.

 

[Ralajer]

I modified the function to search from the end going up so it will find the last instance of the name from the bottom. I added some checks to prevent people from checking out if they haven't checked in prior or if they have checked in and checked out but haven't checked in. If a user checks in Several times without checking out the below will just check out the last check in.

Keep Private Sub CommandButton1_Click as is but change Private Sub CommandButton2_Click to this.

Private Sub CommandButton2_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("sheet1")

If Trim(Me.TextBox1.Value) = "" Then
  Me.TextBox1.SetFocus
  MsgBox "OOOp's...Did you forget First or Last Name?"
  Exit Sub
End If
If Trim(Me.TextBox2.Value) = "" Then
  Me.TextBox2.SetFocus
  MsgBox "Please enter Required Information"
  Exit Sub
End If

iRow = RowFromPair(Me.TextBox1.Value, Me.TextBox2.Value, _
                    ws.Range("A:A"), ws.Range("B:B"))

If iRow = -1 Then
    MsgBox "You have checked in yet"
    Exit Sub
Else
    If ws.Cells(iRow, 5).Value <> Empty Then
        MsgBox "You have checked out twice in a row"
        Exit Sub
    Else
        ws.Cells(iRow, 5).Value = Time()
    End If
End If
'clear the data
Me.TextBox1.Value = ""
Me.TextBox2.Value = ""


ws.Cells(iRow, 5).Value = Time()
End Sub

Private Function RowFromPair( _
                Pair_1_Str As String, _
                Pair_2_Str As String, _
                Pair_1_Rng As Range, _
                Pair_2_Rng As Range) As Long

    Dim foundRng As Range
    Dim firstFound As Long
    Dim Pair_1_StrRow As Long
    Dim Offset1to2 As Integer
    
    '// Default return
    RowFromPair = -1
    
    '// Offset from item 1 to 2
    Offset1to2 = Pair_2_Rng.Column - Pair_1_Rng.Column
    
    On Error Resume Next
    
    
    Set foundRng = Pair_1_Rng.Find(What:=Pair_1_Str, After:=Pair_1_Rng.Cells(1, 1), _
                                    Searchdirection:=xlPrevious)
    
    If foundRng Is Nothing Then
        GoTo earlyExit
    End If
    foundRng.Select
    If foundRng.Offset(0, Offset1to2).Value = Pair_2_Str Then
        RowFromPair = foundRng.Row
        GoTo earlyExit
    End If
    foundRng.Select
    firstFound = foundRng.Row
    
    Do While True
        Set foundRng = Pair_1_Rng.FindPrevious(foundRng)
        foundRng.Select
        If foundRng Is Nothing Then GoTo earlyExit
        If foundRng.Row = firstFound Then GoTo earlyExit
        
        If foundRng.Offset(0, Offset1to2).Value = Pair_2_Str Then
            RowFromPair = foundRng.Row
            Exit Do
        End If
    Loop
    On Error GoTo 0

earlyExit:

End Function

 

[riosaaron]

Thank you So much- it works PERFECTLY!!!