Speed problems and Authorization Denied error

G

Greggg

New Member
Joined
Oct 27, 2015
Messages
1
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
  1. Manualy copy all information from sheet 3 manualy paste into sheet 1 cell A3
  2. Manualy copy an individual employees information from sheet 4 and manualy past it into shett 1 cell A35
  3. Run the "Please_work" macro (Button on sheet 1)
  4. Run "Clear_TR" macro (Button on sheet 1)
  5. Repeat steps 2-3 for each employees information in sheet 4
  6. Run "Create_mail" macro
  7. 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>
Sheet 3 Data
8/10/20157079314Task 4xxxnonexxT Gar10FALSETRUE0L Kit10TRUEFALSE0C Col10TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/9/20157079314Task 4xxxnonexxL Kit10FALSETRUE0C Col10TRUEFALSE0T Gar10TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/8/20157079314Task 4xxxnonexxL Kit101FALSETRUE8C Col101TRUEFALSE0T Gar101TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/7/20157079314Task 4xxxnonexxL Kit103FALSETRUE0C Col103TRUEFALSE0T Gar103TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/6/20157079314Task 4xxxnonexxC Col104FALSETRUE0T Gar103.5TRUEFALSE0L Kit103.5TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/5/20157079314Task 4xxxNonexxC Col100.5FALSETRUE0L Kit100.5TRUEFALSE0T Gar100.5TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/4/20157079314Task 4xxxnonexxL Kit101.5FALSETRUE0C Col101.5TRUEFALSE0T Gar101.5TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report
8/3/20157079314Task 4xxxnonexxL Kit10FALSETRUE0C Col10TRUEFALSE0T Gar10TRUEFALSE0FALSEFALSE0FALSEFALSE0FALSEFALSE0enterNameFALSEFALSE0EnterNameFALSEFALSE0enterNameFALSEFALSE0####Itemteam/testSite/Lists/Signal Daily Progress Report

<tbody>
</tbody>

Sheet 4 Data

KIT , L Col , CBRI , LLOP, PGAR, T
WorkGang IdCenterPositionWorkPCHH MMAmountAcct-Cost-RsnOT RsnLocation IDSpecialBill toLSMPWorkGang IdCenterPositionWorkPCHH MMAmountAcct-Cost-RsnOT RsnLocation IDSpecialBill toLSMPWorkGang IdCenterPositionWorkPCHH MMAmountAcct-Cost-RsnOT RsnLocation IDSpecialBill toLSMPWorkGang IdCenterPositionWorkPCHH MMAmountAcct-Cost-RsnOT RsnLocation IDSpecialBill toLSMPWorkGang IdCenterPositionWorkPCHH MMAmountAcct-Cost-RsnOT RsnLocation IDSpecialBill toLSMP
DateTimesProjectCenterDateTimesProjectCenterDateTimesProjectCenterDateTimesProjectCenterDateTimesProjectCenter
8/1/2015xxxxxRD10 00xxxxx-xxxx8/1/2015xxxxxRD10 00xxxxx-xxxx8/1/2015xxxxxRD10 00xxxxx-xxxx8/1/2015xxxxxRD10 00xxxxx-xxxx8/1/2015SSCX0137xxxxRD10 00xxxxx-xxxx
xxxxx908 00xxxxxJ007309xxxx8/2/2015xxxxxRD10 00xxxxx-xxxx8/2/2015xxxxxRD10 00xxxxx-xxxx8/2/2015xxxxxRD10 00xxxxx-xxxx8/2/2015SSCX0137xxxxRD10 00xxxxx-xxxx
8/2/2015xxxxxRD10 00xxxxx-xxxx8/3/2015xxxxx110 00xxxxx7079314xxxx8/3/2015xxxxxT708 00xxxxxJ007309xxxx8/3/2015xxxxxT708 00xxxxxJ007309xxxx8/3/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/3/2015xxxxx110 00xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxx8/4/2015xxxxxT708 00xxxxxJ007309xxxx8/4/2015xxxxxT708 00xxxxxJ007309xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxxxxxxx6710 00xxxxx7079314xxxx8/5/2015xxxxxT708 00xxxxxJ007309xxxx8/5/2015xxxxxT708 00xxxxxJ007309xxxxSSCX0137xxxx6710 00xxxxx7079314xxxx
xxxxx6510 00xxxxx7079314xxxx8/4/2015xxxxx110 00xxxxx7079314xxxx8/6/2015xxxxxT708 00xxxxxJ007309xxxx8/6/2015xxxxxT708 00xxxxxJ007309xxxx8/4/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/4/2015xxxxx110 00xxxxx7079314xxxxxxxxx1201 30xxxxx7079314xxxx8/7/2015xxxxxT708 00xxxxxJ007309xxxx8/7/2015xxxxxT708 00xxxxxJ007309xxxxSSCX0137xxxx1201 30xxxxx7079314xxxx
xxxxx1201 30xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxx8/8/2015xxxxxXX08 00xxxxx7079314xxxx8/8/2015xxxxxXX08 00xxxxx7079314xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxxxxxxx6711 30xxxxx7079314xxxx8/9/2015xxxxxXX08 00xxxxx7079314xxxx8/9/2015xxxxxXX08 00xxxxx7079314xxxxSSCX0137xxxx6711 30xxxxx7079314xxxx
xxxxx6511 30xxxxx7079314xxxx8/5/2015xxxxx110 00xxxxx7079314xxxx8/10/2015xxxxxT708 00xxxxxJ007309xxxx8/10/2015xxxxxT708 00xxxxxJ007309xxxx8/5/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/5/2015xxxxx110 00xxxxx7079314xxxxxxxxx1200 30xxxxx7079314xxxx8/11/2015xxxxxRD10 00xxxxx-xxxx8/11/2015xxxxxRD10 00xxxxx-xxxxSSCX0137xxxx1200 30xxxxx7079314xxxx
xxxxx1200 30xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxxxxxxT708 00xxxxxJ007309xxxxxxxxxT708 00xxxxxJ007309xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxxxxxxx6710 30xxxxx7079314xxxx8/12/2015xxxxxRD10 00xxxxx-xxxx8/12/2015xxxxxRD10 00xxxxx-xxxxSSCX0137xxxx6710 30xxxxx7079314xxxx
xxxxx6510 30xxxxx7079314xxxx8/6/2015xxxxx110 00xxxxx7079314xxxxxxxxxT708 00xxxxxJ007309xxxxxxxxxT708 00xxxxxJ007309xxxx8/6/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/6/2015xxxxx110 00xxxxx7079314xxxxxxxxx1204 00xxxxx7079314xxxx8/13/2015xxxxxRD10 00xxxxx-xxxx8/13/2015xxxxxRD10 00xxxxx-xxxxSSCX0137xxxx1203 30xxxxx7079314xxxx
xxxxx1203 30xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxxxxxxT708 00xxxxxJ007309xxxxxxxxxT708 00xxxxxJ007309xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxxxxxxx6714 00xxxxx7079314xxxx8/14/2015xxxxxRD10 00xxxxx-xxxx8/14/2015xxxxxRD10 00xxxxx-xxxxSSCX0137xxxx6713 30xxxxx7079314xxxx
xxxxx6513 30xxxxx7079314xxxx8/7/2015xxxxx110 00xxxxx7079314xxxxxxxxxT708 00xxxxxJ007309xxxxxxxxxT708 00xxxxxJ007309xxxx8/7/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/7/2015xxxxx110 00xxxxx7079314xxxxxxxxx1203 00xxxxx7079314xxxx8/15/2015xxxxxRD10 00xxxxx-xxxx8/15/2015xxxxxRD10 00xxxxx-xxxxSSCX0137xxxx1203 00xxxxx7079314xxxx
xxxxx1203 00xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxxxxxxx6713 00xxxxx7079314xxxxSSCX0137xxxx6713 00xxxxx7079314xxxx
xxxxx6513 00xxxxx7079314xxxx8/8/2015xxxxx110 00xxxxx7079314xxxx8/8/2015SSCX0137xxxx110 00xxxxx7079314xxxx
8/8/2015xxxxx110 00xxxxx7079314xxxxxxxxx1201 00xxxxx7079314xxxxSSCX0137xxxx1201 00xxxxx7079314xxxx
xxxxx908 00xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
xxxxx1201 00xxxxx7079314xxxxxxxxx6711 00xxxxx7079314xxxxSSCX0137xxxx6711 00xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxx8/9/2015xxxxx110 00xxxxx7079314xxxx8/9/2015SSCX0137xxxx110 00xxxxx7079314xxxx
xxxxx6511 00xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
8/9/2015xxxxx110 00xxxxx7079314xxxxxxxxx6710 00xxxxx7079314xxxxSSCX0137xxxx6710 00xxxxx7079314xxxx
xxxxx5000 01xxxxx7079314xxxx8/10/2015xxxxx110 00xxxxxJ007309xxxx8/10/2015SSCX0137xxxx110 00xxxxxJ007309xxxx
xxxxx6510 00xxxxx7079314xxxxxxxxx5000 01xxxxx7079314xxxxSSCX0137xxxx5000 01xxxxx7079314xxxx
8/10/2015xxxxx110 00xxxxxJ007309xxxxxxxxx6710 00xxxxxJ007309xxxxSSCX0137xxxx6710 00xxxxxJ007309xxxx
xxxxx5000 01xxxxx7079314xxxx8/11/2015xxxxxRD10 00xxxxx-xxxx8/11/2015SSCX0137xxxxRD10 00xxxxx-xxxx
xxxxx6510 00xxxxxJ007309xxxx8/12/2015xxxxxRD10 00xxxxx-xxxx8/12/2015SSCX0137xxxxRD10 00xxxxx-xxxx
8/11/2015xxxxxRD10 00xxxxx-xxxx8/13/2015xxxxxRD10 00xxxxx-xxxx8/13/2015SSCX0137xxxxRD10 00xxxxx-xxxx
8/12/2015xxxxxRD10 00xxxxx-xxxx8/14/2015xxxxxRD10 00xxxxx-xxxx8/14/2015SSCX0137xxxxRD10 00xxxxx-xxxx
8/13/2015xxxxxRD10 00xxxxx-xxxx8/15/2015xxxxxRD10 00xxxxx-xxxx8/15/2015SSCX0137xxxxRD10 00xxxxx-xxxx
8/14/2015xxxxxRD10 00xxxxx-xxxx
8/15/2015xxxxxRD10 00xxxxx-xxxx
xxxxx908 00xxxxxJ007309xxxx

<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
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
You must log in or register to reply here.

Similar threads

G
  • Question
Filling cells with multiple " IF " & " THEN " in the formula
Replies
0
Views
90
Guy Boot
G
J
  • Question
sumif function with delayed application
Replies
5
Views
149
jbrown021286
J
M
  • Solved
Make a new VBA faster
2
Replies
17
Views
733
Alex Blakenburg
A
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
453
AndyEd
A
L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
439
Legacy 352679
L

Forum statistics

Threads
1,215,516
Messages
6,125,280
Members
449,220
Latest member
Excel Master

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top