This code compares to sets of information containing similar data in different formats and checks to make sure everything matches for each day. Data that is checked are Employee names, Dates, Hours worked, project billing number (AFE), and pay codes.
The program works it is just very slow and since my company moved to Windows 8 I get an Authorization Denied error but the program still runs as intended.
Let me explain the Workbook layout
Sheet 1 - Where all the data to be compared is placed and the employee name is selected from a drop down in G2
Sheet 2 - List of Employee names for drop down
Sheet 3 - a pivot table of the first set of data that gets pasted into A3 in sheet 1
Sheet 4 - Each employees individual pay information that gets pasted one by one into A35
How I run the program
This is my first post and I tried to provide as much as possible so I could be helped easily. You should be able to copy and paste everything, create a few buttons, follow the steps above and see the issues i'm having. Thanks
Sheet 2 Data
<tbody>
</tbody>Sheet 3 Data
<tbody>
</tbody>
Sheet 4 Data
<tbody>
</tbody>
Code
Sub PleaseWork()
Application.CutCopyMode = False
answer = MsgBox("Is the correct employee selected?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbYes Then
Application.ScreenUpdating = False
Dim rFind As Range
RowsB = Cells(Rows.Count, 2).End(xlUp).Row 'Find the number of total rows in column B
Rows100 = Cells(Rows.Count, 100).End(xlUp).Row 'Find the number of total rows in column B
Rows100 = Rows100 + 2
Straight = 0
Over = 0
EmployeeName = Cells(2, 7).Value 'Name from drop down
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
For I = 35 To RowsB - 1 'Fill dates for Time Review
Cells(I, 1).Copy
check = Cells(I + 1, 1)
If IsEmpty(check) Then
Cells(I + 1, 1).Select
ActiveSheet.Paste
End If
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Chack dates
Range(Cells(3, 1), Cells(33, 1)).Interior.ColorIndex = 3 ' Highlight entire new column red
Range(Cells(35, 1), Cells(RowsB, 1)).Interior.ColorIndex = 3 ' Highlight entire new column red
Count = 0 'Counter for the number of matched cells
For I = 35 To RowsB 'Look at a neww number
For j = 3 To 33 ' Compare new to all old
DateCheckTR = Cells(I, 1).Value
DateCheckSP = Cells(j, 1).Value
If DateCheckTR = DateCheckSP Then
Cells(I, 1).Interior.ColorIndex = -4142 'Highlight new value white if equal to old
Cells(j, 1).Interior.ColorIndex = -4142 'Highlight old value white if equal to new
Count = Count + 1
End If
If IsEmpty(Cells(j, 1)) Then
Cells(j, 1).Interior.ColorIndex = -4142
End If
Next j
Next I
For I = 3 To RowsB + 1
ColorCheck = Cells(I, 1).Interior.ColorIndex
If Cells(I, 1).Interior.ColorIndex = 3 And Not IsEmpty(Cells(I, 1)) And I < 34 Then
Cells(Rows100, 100).Value = "The date " & Cells(I, 1).Value & " was entered in Share Point but not in Time Review. " & vbNewLine
Rows100 = Rows100 + 1
ElseIf Cells(I, 1).Interior.ColorIndex = 3 And Cells(I, 1) <> Cells(I - 1, 1) And I > 34 Then
If Cells(I, 1).Value = 1 Or Cells(I, 1).Value = 12 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 24 Then
Cells(Rows100, 100).Value = "The date " & Cells(I, 1).Value & " was entered in Time Review but not in Share Point. " & vbNewLine
Rows100 = Rows100 + 1
End If
End If
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Rows100 = Cells(Rows.Count, 100).End(xlUp).Row + 1 'Find the number of total rows in column B
AFErepeat = 0
For I = RowsB To 35 Step -1 'Outermost loop increments TR dates
StraightOver = Cells(I, 7).Value 'TR Pay codes
TRDate = Cells(I, 1).Value 'TR
TRHours = Cells(I, 8).Value 'TR hours listed column H or 8
If InStr(1, TRHours, " ") Then 'Changes the format of the Time Review hour to the same format as Share Point
tmpArray = Split(TRHours, " ") 'Looks for a " " in cell and uses that to split the cell information
TRHoursCalculated = (tmpArray(0) + (tmpArray(1) / 60))
End If
'AFEcheck = 0
For j = 3 To 33 'Increments Share Point dates
SPDate = Cells(j, 1).Value 'SP dates variable
GangID = Cells(j, 2).Value 'SP BNSF gang ID
'Dim AFEtimeReview As String
'Dim AFEsharePoint As Double
If Cells(I, 14).Value = "-" Or IsEmpty(Cells(I, 14)) Then
Cells(I, 14).Value = 0
End If
Cells(I, 14).Hyperlinks.Delete
AFEtimeReview = Cells(I, 14).Value
AFEsharePoint = Cells(j, 2).Value
AFEtimeReview2 = CStr(AFEtimeReview) 'convert string to double
AFEsharePoint2 = CStr(AFEsharePoint)
If TRDate = SPDate Then 'Begins the error checking loops
For K = 10 To 74 Step 8 'increments SP employee names in row i
NameCheck = Cells(j, K) 'SP employee names
SPStraightHours = Cells(j, K + 1).Value 'Pay code 1 hours
SPOverHours = Cells(j, K + 2).Value 'Pay code 12 hours
SPCode9 = Cells(j, K + 5).Value 'Pay code 9 hours
'Eliminates case sensitivity for the names
Set rFind = Cells(j, K).Find(What:=EmployeeName, _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False, _
SearchFormat:=False)
SameDate = Cells(I - 1, 1) 'Variable for the last date looked at in the TR section
If Not rFind Is Nothing Then
If AFEtimeReview2 <> AFEsharePoint2 Then
Cells(I, 14).Interior.ColorIndex = 3 'AFEtimeReview
Cells(j, 2).Interior.ColorIndex = 3 'AFESharePoint
If Cells(I, 14) = Cells(I - 1, 14) And AFErepeat < 1 Then
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review AFE's do not match. " & vbNewLine
AFErepeat = 1
ElseIf AFErepeat > 0 And Cells(I, 14) <> Cells(I - 1, 14) Then
AFErepeat = 0
End If
Rows100 = Rows100 + 1
End If
If rFind.Address(ReferenceStyle:=xlR1C1) = Cells(j, K).Address(ReferenceStyle:=xlR1C1) Then 'Check both names adresses match
If SameDate <> TRDate Then 'SP Highlights pay information for that date green. Ensures this only happens for 1 TR date
Range(Cells(j, K), Cells(j, K + 5)).Interior.ColorIndex = 4
'1 black, 2 white, 3 red, 4 neon green, 5 blue 6=yellow, 7= light purple, 8 teal, 9 brown, 10 dark green
End If
Select Case StraightOver 'Pay code cases.
Case 1
If TRHoursCalculated <> SPStraightHours Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 1).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case 12
If TRHoursCalculated <> SPOverHours Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case 9
If TRHoursCalculated <> SPCode9 Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 5).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
End Select
End If
End If
Next K
End If
Next j
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Check AFE and Task #
For I = 3 To 33
task = Cells(I, 3).Value
AFE = Cells(I, 2).Value
If Not IsEmpty(Cells(I, 2)) Then
Date = CStr(Cells(I, 1).Value)
End If
Select Case task
Case "Task 2"
If AFE <> 7005114 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 3"
If AFE <> 7076514 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 4"
If AFE <> 7079314 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 8"
If AFE <> 7004414 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 9"
If AFE <> 7024913 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 15"
If AFE <> 7029814 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task Mt V"
If AFE <> 7030814 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
End Select
Next I
Application.ScreenUpdating = True
Else
'do nothing
End If
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
End Sub
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Sub Clear_All() 'Clears cells of any fill color
Application.ScreenUpdating = False
Range("A3: CF33, A35: CF1000").Interior.ColorIndex = -4142
Range("A3: CF33, A35: CF1000").Select
Selection.ClearContents
Range(Cells(3, 100), Cells(1000, 100)).Select
Selection.ClearContents
Cells(3, 101).Select
Selection.ClearContents
Application.ScreenUpdating = True
End Sub
Sub Clear_TR() 'Clears cells of any fill color
Application.ScreenUpdating = False
Range("A35: CF1000").Select
Selection.ClearContents
Range("A35: CF1000").Interior.ColorIndex = -4142
Application.ScreenUpdating = True
End Sub
Sub No_Fill() 'Clears cells of any fill color
Range("A3: CF33, A35: CF1000").Interior.ColorIndex = -4142
Application.ScreenUpdating = True
End Sub
Sub CreateMail()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
'rngSubject = "Share Point and Time Review errors"
'rngTo = EmployeeName
Rows100 = Cells(Rows.Count, 100).End(xlUp).Row 'Find the number of total rows in column B
'With ActiveSheet
'Set rngTo = .Range("B1")
'Set rngSubject =.Range("B2")
'Set rngBody = Range(Cells(1, 3), Cells(3, 3))
'Set rngAttach = .Range("B4")
'End With
For I = 3 To Rows100
mBody = Cells(I, 100).Value
MsgBody = MsgBody & mBody
Next I
Cells(3, 101).Value = MsgBody
With objMail
'.To = rngTo.Value
.Subject = "Share Point and Time Review errors"
.Body = "Below are all the discrepancies between SharePoint and Time Review. Attached is all the information that was reviewed. Please review and make corrections in SharePoint and Pars." & vbNewLine & Cells(3, 101).Value
'.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
.CC = "SIGDLWSDOTSigSupv@BNSF.com"
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing
End Sub
The program works it is just very slow and since my company moved to Windows 8 I get an Authorization Denied error but the program still runs as intended.
Let me explain the Workbook layout
Sheet 1 - Where all the data to be compared is placed and the employee name is selected from a drop down in G2
Sheet 2 - List of Employee names for drop down
Sheet 3 - a pivot table of the first set of data that gets pasted into A3 in sheet 1
Sheet 4 - Each employees individual pay information that gets pasted one by one into A35
How I run the program
- Manualy copy all information from sheet 3 manualy paste into sheet 1 cell A3
- Manualy copy an individual employees information from sheet 4 and manualy past it into shett 1 cell A35
- Run the "Please_work" macro (Button on sheet 1)
- Run "Clear_TR" macro (Button on sheet 1)
- Repeat steps 2-3 for each employees information in sheet 4
- Run "Create_mail" macro
- Check errors in email to ensure program worked correctly there are some cases that the program will see an error but there is not for example an employee worked two separate projects on the same day.
This is my first post and I tried to provide as much as possible so I could be helped easily. You should be able to copy and paste everything, create a few buttons, follow the steps above and see the issues i'm having. Thanks
Sheet 2 Data
L Kit |
C Col |
P Lop |
L Bri |
T Gar |
<tbody>
</tbody>
8/10/2015 | 7079314 | Task 4 | x | x | x | none | x | x | T Gar | 10 | FALSE | TRUE | 0 | L Kit | 10 | TRUE | FALSE | 0 | C Col | 10 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | |||||||||||||||||||||||||||||||||||||
8/9/2015 | 7079314 | Task 4 | x | x | x | none | x | x | L Kit | 10 | FALSE | TRUE | 0 | C Col | 10 | TRUE | FALSE | 0 | T Gar | 10 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | |||||||||||||||||||||||||||||||||||||
8/8/2015 | 7079314 | Task 4 | x | x | x | none | x | x | L Kit | 10 | 1 | FALSE | TRUE | 8 | C Col | 10 | 1 | TRUE | FALSE | 0 | T Gar | 10 | 1 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | ||||||||||||||||||||||||||||||||||
8/7/2015 | 7079314 | Task 4 | x | x | x | none | x | x | L Kit | 10 | 3 | FALSE | TRUE | 0 | C Col | 10 | 3 | TRUE | FALSE | 0 | T Gar | 10 | 3 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | ||||||||||||||||||||||||||||||||||
8/6/2015 | 7079314 | Task 4 | x | x | x | none | x | x | C Col | 10 | 4 | FALSE | TRUE | 0 | T Gar | 10 | 3.5 | TRUE | FALSE | 0 | L Kit | 10 | 3.5 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | ||||||||||||||||||||||||||||||||||
8/5/2015 | 7079314 | Task 4 | x | x | x | None | x | x | C Col | 10 | 0.5 | FALSE | TRUE | 0 | L Kit | 10 | 0.5 | TRUE | FALSE | 0 | T Gar | 10 | 0.5 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | ||||||||||||||||||||||||||||||||||
8/4/2015 | 7079314 | Task 4 | x | x | x | none | x | x | L Kit | 10 | 1.5 | FALSE | TRUE | 0 | C Col | 10 | 1.5 | TRUE | FALSE | 0 | T Gar | 10 | 1.5 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report | ||||||||||||||||||||||||||||||||||
8/3/2015 | 7079314 | Task 4 | x | x | x | none | x | x | L Kit | 10 | FALSE | TRUE | 0 | C Col | 10 | TRUE | FALSE | 0 | T Gar | 10 | TRUE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | EnterName | FALSE | FALSE | 0 | enterName | FALSE | FALSE | 0 | #### | Item | team/testSite/Lists/Signal Daily Progress Report |
<tbody>
</tbody>
Sheet 4 Data
KIT , L | Col , C | BRI , L | LOP, P | GAR, T | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Work | Gang Id | Center | Position | Work | PC | HH MM | Amount | Acct-Cost-Rsn | OT Rsn | Location ID | Special | Bill to | LSMP | Work | Gang Id | Center | Position | Work | PC | HH MM | Amount | Acct-Cost-Rsn | OT Rsn | Location ID | Special | Bill to | LSMP | Work | Gang Id | Center | Position | Work | PC | HH MM | Amount | Acct-Cost-Rsn | OT Rsn | Location ID | Special | Bill to | LSMP | Work | Gang Id | Center | Position | Work | PC | HH MM | Amount | Acct-Cost-Rsn | OT Rsn | Location ID | Special | Bill to | LSMP | Work | Gang Id | Center | Position | Work | PC | HH MM | Amount | Acct-Cost-Rsn | OT Rsn | Location ID | Special | Bill to | LSMP | ||||||||||||||||||||||||||||
Date | Times | Project | Center | Date | Times | Project | Center | Date | Times | Project | Center | Date | Times | Project | Center | Date | Times | Project | Center | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
8/1/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/1/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/1/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/1/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/1/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||
x | x | x | x | x | 9 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/2/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/2/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/2/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/2/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | |||||||||
8/2/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/3/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/3/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/3/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/3/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||
8/3/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | 8/4/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/4/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/5/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/5/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
x | x | x | x | x | 65 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/4/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/6/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/6/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/4/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||
8/4/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 12 | 01 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/7/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/7/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 12 | 01 30 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||
x | x | x | x | x | 12 | 01 30 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | 8/8/2015 | x | x | x | x | x | XX | 08 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/8/2015 | x | x | x | x | x | XX | 08 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 11 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/9/2015 | x | x | x | x | x | XX | 08 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/9/2015 | x | x | x | x | x | XX | 08 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 11 30 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
x | x | x | x | x | 65 | 11 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/5/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/10/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/10/2015 | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/5/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||
8/5/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 12 | 00 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/11/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/11/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | SSCX0137 | x | x | x | x | 12 | 00 30 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||
x | x | x | x | x | 12 | 00 30 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 10 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/12/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/12/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 10 30 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
x | x | x | x | x | 65 | 10 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/6/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/6/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
8/6/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 12 | 04 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/13/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/13/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | SSCX0137 | x | x | x | x | 12 | 03 30 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||
x | x | x | x | x | 12 | 03 30 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 14 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/14/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/14/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 13 30 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
x | x | x | x | x | 65 | 13 30 | x | x | x | x | x | 7079314 | x | x | x | x | 8/7/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | x | x | x | x | x | T7 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/7/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||
8/7/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 12 | 03 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/15/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/15/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | SSCX0137 | x | x | x | x | 12 | 03 00 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||
x | x | x | x | x | 12 | 03 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 13 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 13 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 65 | 13 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/8/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/8/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||
8/8/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 12 | 01 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 12 | 01 00 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 9 | 08 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 12 | 01 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 11 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 11 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | 8/9/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | 8/9/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 65 | 11 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
8/9/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 67 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | 8/10/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/10/2015 | SSCX0137 | x | x | x | x | 1 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 65 | 10 00 | x | x | x | x | x | 7079314 | x | x | x | x | x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | SSCX0137 | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||||
8/10/2015 | x | x | x | x | x | 1 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | x | x | x | x | x | 67 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | SSCX0137 | x | x | x | x | 67 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 50 | 00 01 | x | x | x | x | x | 7079314 | x | x | x | x | 8/11/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/11/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 65 | 10 00 | x | x | x | x | x | J007309 | x | x | x | x | 8/12/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/12/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | |||||||||||||||||||||||||||||||||||||||||||||
8/11/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/13/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/13/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||
8/12/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/14/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/14/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||
8/13/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/15/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | 8/15/2015 | SSCX0137 | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||
8/14/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
8/15/2015 | x | x | x | x | x | RD | 10 00 | x | x | x | x | x | - | x | x | x | x | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
x | x | x | x | x | 9 | 08 00 | x | x | x | x | x | J007309 | x | x | x | x |
<tbody>
</tbody>
Code
Sub PleaseWork()
Application.CutCopyMode = False
answer = MsgBox("Is the correct employee selected?", vbYesNo + vbQuestion, "Empty Sheet")
If answer = vbYes Then
Application.ScreenUpdating = False
Dim rFind As Range
RowsB = Cells(Rows.Count, 2).End(xlUp).Row 'Find the number of total rows in column B
Rows100 = Cells(Rows.Count, 100).End(xlUp).Row 'Find the number of total rows in column B
Rows100 = Rows100 + 2
Straight = 0
Over = 0
EmployeeName = Cells(2, 7).Value 'Name from drop down
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
For I = 35 To RowsB - 1 'Fill dates for Time Review
Cells(I, 1).Copy
check = Cells(I + 1, 1)
If IsEmpty(check) Then
Cells(I + 1, 1).Select
ActiveSheet.Paste
End If
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Chack dates
Range(Cells(3, 1), Cells(33, 1)).Interior.ColorIndex = 3 ' Highlight entire new column red
Range(Cells(35, 1), Cells(RowsB, 1)).Interior.ColorIndex = 3 ' Highlight entire new column red
Count = 0 'Counter for the number of matched cells
For I = 35 To RowsB 'Look at a neww number
For j = 3 To 33 ' Compare new to all old
DateCheckTR = Cells(I, 1).Value
DateCheckSP = Cells(j, 1).Value
If DateCheckTR = DateCheckSP Then
Cells(I, 1).Interior.ColorIndex = -4142 'Highlight new value white if equal to old
Cells(j, 1).Interior.ColorIndex = -4142 'Highlight old value white if equal to new
Count = Count + 1
End If
If IsEmpty(Cells(j, 1)) Then
Cells(j, 1).Interior.ColorIndex = -4142
End If
Next j
Next I
For I = 3 To RowsB + 1
ColorCheck = Cells(I, 1).Interior.ColorIndex
If Cells(I, 1).Interior.ColorIndex = 3 And Not IsEmpty(Cells(I, 1)) And I < 34 Then
Cells(Rows100, 100).Value = "The date " & Cells(I, 1).Value & " was entered in Share Point but not in Time Review. " & vbNewLine
Rows100 = Rows100 + 1
ElseIf Cells(I, 1).Interior.ColorIndex = 3 And Cells(I, 1) <> Cells(I - 1, 1) And I > 34 Then
If Cells(I, 1).Value = 1 Or Cells(I, 1).Value = 12 Or Cells(I, 1).Value = 9 Or Cells(I, 1).Value = 24 Then
Cells(Rows100, 100).Value = "The date " & Cells(I, 1).Value & " was entered in Time Review but not in Share Point. " & vbNewLine
Rows100 = Rows100 + 1
End If
End If
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Rows100 = Cells(Rows.Count, 100).End(xlUp).Row + 1 'Find the number of total rows in column B
AFErepeat = 0
For I = RowsB To 35 Step -1 'Outermost loop increments TR dates
StraightOver = Cells(I, 7).Value 'TR Pay codes
TRDate = Cells(I, 1).Value 'TR
TRHours = Cells(I, 8).Value 'TR hours listed column H or 8
If InStr(1, TRHours, " ") Then 'Changes the format of the Time Review hour to the same format as Share Point
tmpArray = Split(TRHours, " ") 'Looks for a " " in cell and uses that to split the cell information
TRHoursCalculated = (tmpArray(0) + (tmpArray(1) / 60))
End If
'AFEcheck = 0
For j = 3 To 33 'Increments Share Point dates
SPDate = Cells(j, 1).Value 'SP dates variable
GangID = Cells(j, 2).Value 'SP BNSF gang ID
'Dim AFEtimeReview As String
'Dim AFEsharePoint As Double
If Cells(I, 14).Value = "-" Or IsEmpty(Cells(I, 14)) Then
Cells(I, 14).Value = 0
End If
Cells(I, 14).Hyperlinks.Delete
AFEtimeReview = Cells(I, 14).Value
AFEsharePoint = Cells(j, 2).Value
AFEtimeReview2 = CStr(AFEtimeReview) 'convert string to double
AFEsharePoint2 = CStr(AFEsharePoint)
If TRDate = SPDate Then 'Begins the error checking loops
For K = 10 To 74 Step 8 'increments SP employee names in row i
NameCheck = Cells(j, K) 'SP employee names
SPStraightHours = Cells(j, K + 1).Value 'Pay code 1 hours
SPOverHours = Cells(j, K + 2).Value 'Pay code 12 hours
SPCode9 = Cells(j, K + 5).Value 'Pay code 9 hours
'Eliminates case sensitivity for the names
Set rFind = Cells(j, K).Find(What:=EmployeeName, _
LookIn:=xlValues, _
LookAt:=xlPart, _
MatchCase:=False, _
SearchFormat:=False)
SameDate = Cells(I - 1, 1) 'Variable for the last date looked at in the TR section
If Not rFind Is Nothing Then
If AFEtimeReview2 <> AFEsharePoint2 Then
Cells(I, 14).Interior.ColorIndex = 3 'AFEtimeReview
Cells(j, 2).Interior.ColorIndex = 3 'AFESharePoint
If Cells(I, 14) = Cells(I - 1, 14) And AFErepeat < 1 Then
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review AFE's do not match. " & vbNewLine
AFErepeat = 1
ElseIf AFErepeat > 0 And Cells(I, 14) <> Cells(I - 1, 14) Then
AFErepeat = 0
End If
Rows100 = Rows100 + 1
End If
If rFind.Address(ReferenceStyle:=xlR1C1) = Cells(j, K).Address(ReferenceStyle:=xlR1C1) Then 'Check both names adresses match
If SameDate <> TRDate Then 'SP Highlights pay information for that date green. Ensures this only happens for 1 TR date
Range(Cells(j, K), Cells(j, K + 5)).Interior.ColorIndex = 4
'1 black, 2 white, 3 red, 4 neon green, 5 blue 6=yellow, 7= light purple, 8 teal, 9 brown, 10 dark green
End If
Select Case StraightOver 'Pay code cases.
Case 1
If TRHoursCalculated <> SPStraightHours Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 1).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case 12
If TRHoursCalculated <> SPOverHours Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case 9
If TRHoursCalculated <> SPCode9 Then
Cells(I, 8).Interior.ColorIndex = 3
Cells(j, K + 5).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & TRDate & " " & EmployeeName & "'s" & " Share Point and Time Review hours do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
End Select
End If
End If
Next K
End If
Next j
Next I
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
'Check AFE and Task #
For I = 3 To 33
task = Cells(I, 3).Value
AFE = Cells(I, 2).Value
If Not IsEmpty(Cells(I, 2)) Then
Date = CStr(Cells(I, 1).Value)
End If
Select Case task
Case "Task 2"
If AFE <> 7005114 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 3"
If AFE <> 7076514 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 4"
If AFE <> 7079314 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 8"
If AFE <> 7004414 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 9"
If AFE <> 7024913 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task 15"
If AFE <> 7029814 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
Case "Task Mt V"
If AFE <> 7030814 Then
Cells(I, 2).Interior.ColorIndex = 3
Cells(Rows100, 100).Value = "On " & Date & " " & EmployeeName & "'s" & " Share Point task and AFE do not match. " & vbNewLine
Rows100 = Rows100 + 1
End If
End Select
Next I
Application.ScreenUpdating = True
Else
'do nothing
End If
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite
End Sub
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
Sub Clear_All() 'Clears cells of any fill color
Application.ScreenUpdating = False
Range("A3: CF33, A35: CF1000").Interior.ColorIndex = -4142
Range("A3: CF33, A35: CF1000").Select
Selection.ClearContents
Range(Cells(3, 100), Cells(1000, 100)).Select
Selection.ClearContents
Cells(3, 101).Select
Selection.ClearContents
Application.ScreenUpdating = True
End Sub
Sub Clear_TR() 'Clears cells of any fill color
Application.ScreenUpdating = False
Range("A35: CF1000").Select
Selection.ClearContents
Range("A35: CF1000").Interior.ColorIndex = -4142
Application.ScreenUpdating = True
End Sub
Sub No_Fill() 'Clears cells of any fill color
Range("A3: CF33, A35: CF1000").Interior.ColorIndex = -4142
Application.ScreenUpdating = True
End Sub
Sub CreateMail()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
'rngSubject = "Share Point and Time Review errors"
'rngTo = EmployeeName
Rows100 = Cells(Rows.Count, 100).End(xlUp).Row 'Find the number of total rows in column B
'With ActiveSheet
'Set rngTo = .Range("B1")
'Set rngSubject =.Range("B2")
'Set rngBody = Range(Cells(1, 3), Cells(3, 3))
'Set rngAttach = .Range("B4")
'End With
For I = 3 To Rows100
mBody = Cells(I, 100).Value
MsgBody = MsgBody & mBody
Next I
Cells(3, 101).Value = MsgBody
With objMail
'.To = rngTo.Value
.Subject = "Share Point and Time Review errors"
.Body = "Below are all the discrepancies between SharePoint and Time Review. Attached is all the information that was reviewed. Please review and make corrections in SharePoint and Pars." & vbNewLine & Cells(3, 101).Value
'.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
.CC = "SIGDLWSDOTSigSupv@BNSF.com"
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing
End Sub