debauch
09-09-2005, 01:23 PM
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
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