Sleeper: Can I loop this ?

[debauch]

Ok,
my 42 hour course, only took me so far. I am a little shaky when it comes to loops using vba code. I will paste what I am using 10 times over (would like to have it up to 50 or so) but I have to re-type and change little bits to make the next one work . Is there any way to loop through this information ? If so, when I apply this to multiple databases, I wont be making tedious changes all day long trying to implment it ..

Private Sub commandbutton2_click()
'On Error GoTo NotFound
On Error Resume Next
'This was copy EMp ID, find AActUsers, copy TermDate, Pate term date DB
'1st Cell
If Sheets("Attrition").Range("k14") = Empty Then
MsgBox ("Enter Employee ID")
Exit Sub
End If
Dim ToFind As String
ToFind = Sheets("Attrition").Range("k14")
Sheets("ActiveUsers").Activate 'Activate new sheet
'On Error GoTo NotFound
Sheets("ActiveUsers").Cells.Find(What:=ToFind, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'Exit Sub
'NotFound:
'MsgBox "Data not found"
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l14").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k15") = Empty Then
Exit Sub
End If
'2nd Cell
Dim ToFind2 As String
ToFind2 = Sheets("Attrition").Range("k15")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind2, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l15").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k16") = Empty Then
Exit Sub
End If
'3rd Cell
Dim ToFind3 As String
ToFind3 = Sheets("Attrition").Range("k16")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind3, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l16").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k17") = Empty Then
Exit Sub
End If
'4th Cell
Dim ToFind4 As String
ToFind4 = Sheets("Attrition").Range("k17")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind4, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l17").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k18") = Empty Then
Exit Sub
End If
'5th Cell
Dim ToFind5 As String
ToFind5 = Sheets("Attrition").Range("k18")
Sheets("ActiveUsers").Activate 'Activate new sheet
'On Error GoTo NotFound
Sheets("ActiveUsers").Cells.Find(What:=ToFind5, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l18").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k19") = Empty Then
Exit Sub
End If
'6th Cell
Dim ToFind6 As String
ToFind6 = Sheets("Attrition").Range("k19")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind6, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l19").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k20") = Empty Then
Exit Sub
End If
'7th Cell
Dim ToFind7 As String
ToFind7 = Sheets("Attrition").Range("k20")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind7, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l20").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k21") = Empty Then
Exit Sub
End If
'8th Cell
Dim ToFind8 As String
ToFind8 = Sheets("Attrition").Range("k21")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind8, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l21").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k22") = Empty Then
Exit Sub
End If
'9th Cell
Dim ToFind9 As String
ToFind9 = Sheets("Attrition").Range("k22")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind9, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l22").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
If Sheets("Attrition").Range("k23") = Empty Then
Exit Sub
End If
'10th Cell
Dim ToFind10 As String
ToFind10 = Sheets("Attrition").Range("k23")
Sheets("ActiveUsers").Activate 'Activate new sheet
Sheets("ActiveUsers").Cells.Find(What:=ToFind10, After:=[A1], LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False).Activate
'copy term date? DIM term date ?
ActiveCell.Offset(0, 29).Select 'term date from HR
'copy term date
Sheets("Attrition").Activate
Range("l23").Copy
'paste term date
Sheets("ActiveUsers").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'select HR date & input today's date
ActiveCell.Offset(0, 2).Select
ActiveCell.FormulaR1C1 = "=NOW()"
MsgBox ("Complete!")
'NotFound:
'Exit Sub
End Sub

[Norie]

What do you actually want to do?

[Jacob Hilderbrand]

Try something along these lines. This example will loop from Row 14 to 50.

Option Explicit
 
Private Sub commandbutton2_click()
Dim i               As Long
Dim ToFind          As String
Dim Cel             As Range
For i = 14 To 50
        If Sheets("Attrition").Range("k" & i) = Empty Then
            MsgBox ("Enter Employee ID")
            Exit Sub
        End If
        ToFind = Sheets("Attrition").Range("k" & i).Text
        Set Cel = Sheets("ActiveUsers").Cells.Find(What:=ToFind, After:=[A1], _
            LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False)
        If Not Cel Is Nothing Then
            Cel.Value = Sheets("Attrition").Range("l" & i)
            Cel.Offset(0, 2).Value = "=NOW()"
        Else
            'No Match, you can add a message box here.
        End If
    Next i
    Set Cel = Nothing
End Sub

[debauch]

What do you actually want to do?

It is a database of 1000 + users, when these users quit, I copy a list of employee #'s, paste is into attrtion sheet, and it plugs the quit dates into the active users tab, then I sort by term (quit) date, and cut it out of the database and put it into another file of agents who longer are employee or active with us.

I hhave to do this to several databbases several times a day, so this cuts out so much time.

Now DRJ ... if that is all I need you are the man. I will test this and let you know how it works out, thanks again.

[debauch]

Ok, I changed it a little bit, I need attrition "L" date to be one date, and to columns over be today's date. That parts works fine, but for some reason, it is pasting the "L" range on attrition tab, onto employee # on active user tab ?

Private Sub commandbutton2_click()
Dim i               As Long
    Dim ToFind          As String
    Dim Cel             As Range
For i = 14 To 50
        If Sheets("Attrition").Range("k" & i) = Empty Then
            MsgBox ("Enter Employee ID")
            Exit Sub
        End If
        ToFind = Sheets("Attrition").Range("k" & i).Text
        Set Cel = Sheets("ActiveUsers").Cells.Find(What:=ToFind, After:=[A1], _
        LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False)
        If Not Cel Is Nothing Then
        Cel.Value = Sheets("Attrition").Range("l" & i)
            Cel.Offset(0, 29).Value = Sheets("Attrition").Range("l" & i)
            Cel.Value = Sheets("Attrition").Range("l" & i)
            Cel.Offset(0, 31).Value = "=NOW()"
        Else
             'No Match, you can add a message box here.
        End If
    Next i
    Set Cel = Nothing
End Sub

If we can get that to stop, I should be set. It works great though, much faster that what I has previously.

[Jacob Hilderbrand]

I am not sure what you mean, it is hard to see what you want. Can you post an attachment?

But you should be able to modify the code if we are just off by a range or sheet.

Cel is the range that the ToFind value was found in. So you can then offset Cel however you want to get the right value. If a value is being placed on the wrong sheet, then you need to specify the correct sheet name in the code, such as; Sheets("Sheet1").Range(...

[debauch]

Thanks Jake, I will fiddle with this some more, I am being lazy, I will be back if completely stuck, thanjks.