Blobajob88
Board Regular
- Joined
- Mar 27, 2020
- Messages
- 55
- Office Version
- 365
- 2019
- Platform
- Windows
Hi,
I've produced code in the activate and change events on a spreadsheet I am working on and it keeps crashing my computer. Could someone please have a look at my code and figure out why. It technically works but is too demanding of my laptop
I've produced code in the activate and change events on a spreadsheet I am working on and it keeps crashing my computer. Could someone please have a look at my code and figure out why. It technically works but is too demanding of my laptop
VBA Code:
Private Sub Worksheet_Activate()
ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True
Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If
Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If
Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If
x = Cells(Rows.Count, 2).End(xlUp).Row
'If Not Application.Intersect(Target, Range("k3:z60")) Is Nothing Then
'For i = 8 To x
''
'If Range("m" & i).Value = "" Or Range("o" & i).Value = "" Then
'Range("R" & i).Value = "Enter an Order & a Lead Time"
'End If
'Next i
'End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Worksheets("Procurement Schedule").Unprotect
Application.ScreenUpdating = False
x = Cells(Rows.Count, 2).End(xlUp).Row
Dim Rng As Range
Set Rng = Range("m8:m" & x)
If Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Then
For Each Cell In Rng
If Cell.Value > "" And Not IsDate(Cell.Value) Then
Cell.Value = ""
Cell.Select
MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
End If
Next
End If
'Data validation for skid/kiosk/site completion dates
If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Dim Rng9 As Range
Set Rng9 = Range("o3:o5")
For Each Cell In Rng9
If Cell.Value > "" And Not IsDate(Cell.Value) Then
Cell.Value = ""
Cell.Select
MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
End If
Next
End If
'Data validation for project delivery date
If Not Application.Intersect(Target, Range("I5")) Is Nothing Then
Dim Rng10 As Range
Set Rng10 = Range("I5")
For Each Cell In Rng9
If Cell.Value > "" And Not IsDate(Cell.Value) Then
Cell.Value = ""
Cell.Select
MsgBox "Please Enter a valid date e.g. 25-05-2005 or 25/05/2005"
End If
Next
End If
Range("B7").CurrentRegion.Borders.LineStyle = xlContinuous
Range("B7").CurrentRegion.BorderAround _
ColorIndex:=0, Weight:=xlThick
Range("B7:V7").BorderAround ColorIndex:=0, Weight:=xlThick
Columns("A:Z").AutoFit
'if value in 'How many have you ordered?' and 'How many are in stock?' then the 'Quantity left to order' value changes
If Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Range("p3").Value = DateDiff("d", Date, Range("o3").Value) & " Days Until Skid Completion"
If DateDiff("d", Date, Range("o3").Value) >= 21 Then
Range("p3").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o3").Value) >= 10 And DateDiff("d", Date, Range("o3").Value) < 21 Then
Range("p3").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o3").Value) < 10 Then
Range("p3").Font.Color = rgbRed
End If
Range("p4").Value = DateDiff("d", Date, Range("o4").Value) & " Days Until Kiosk Completion"
If DateDiff("d", Date, Range("o4").Value) >= 21 Then
Range("p4").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o4").Value) >= 10 And DateDiff("d", Date, Range("o4").Value) < 21 Then
Range("p4").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o4").Value) < 10 Then
Range("p4").Font.Color = rgbRed
End If
Range("p5").Value = DateDiff("d", Date, Range("o5").Value) & " Days Until Site Completion"
If DateDiff("d", Date, Range("o5").Value) >= 21 Then
Range("p5").Font.Color = rgbGreen
ElseIf DateDiff("d", Date, Range("o5").Value) >= 10 And DateDiff("d", Date, Range("o5").Value) < 21 Then
Range("p5").Font.Color = rgbOrange
ElseIf DateDiff("d", Date, Range("o5").Value) < 10 Then
Range("p5").Font.Color = rgbRed
End If
End If
'expected delivery date Status
If Not Application.Intersect(Target, Range("n8:n" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Dim Rng2 As Range
Set Rng2 = Range("r8:r" & x)
For Each Cell In Rng2
If Cell.Value <> "" Then
If Cell.Value - Range("o3").Value >= 0 Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Skid Mechanical" Or Cell.Offset(0, -8).Value = "Skid Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Kiosk Mechanical" Or Cell.Offset(0, -8).Value = "Kiosk Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -8).Value = "Site Mechanical" Or Cell.Offset(0, -8).Value = "Site Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
Else
End If
Else
Cell.Interior.ColorIndex = 0
End If
Next
End If
'Actual delivery date Status
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Or Not Application.Intersect(Target, Range("m8:m" & x)) Is Nothing Or Not Application.Intersect(Target, Range("o3:o5")) Is Nothing Then
Dim Rng3 As Range
Set Rng3 = Range("s8:s" & x)
For Each Cell In Rng3
If Cell.Value <> "" Then
If Cell.Value - Range("o3").Value >= 0 Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o3").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o3").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Skid Mechanical" Or Cell.Offset(0, -9).Value = "Skid Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o4").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o4").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Kiosk Mechanical" Or Cell.Offset(0, -9).Value = "Kiosk Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o5").Value - Cell.Value < 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbRed
Cell.NumberFormat = "dddd dd mmmm yyyy"
ElseIf Range("o5").Value - Cell.Value >= 14 And (Cell.Offset(0, -9).Value = "Site Mechanical" Or Cell.Offset(0, -9).Value = "Site Electrical") Then
Cell.Font.Color = rgbWhite
Cell.Interior.Color = rgbGreen
Cell.NumberFormat = "dddd dd mmmm yyyy"
Else
End If
Else
Cell.Interior.ColorIndex = 0
End If
Next
End If
'Determining procurement Status
If Not Application.Intersect(Target, Range("E8:E" & x)) Is Nothing Then
For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
End If
Next i
End If
If Not Application.Intersect(Target, Range("F8:F" & x)) Is Nothing Then
For i = 8 To x
If Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) <= 0 Then
Cells(i, 16).Value = "Complete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) > 0 And Cells(i, 7) >= 0 Then
Cells(i, 16).Value = "Incomplete: Some in Stock and Some on Order"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Partially Ordered"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value > 0 And Cells(i, 6) = 0 And Cells(i, 5).Value >= Cells(i, 4).Value Then
Cells(i, 16).Value = "Complete: Fully Ordered"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) = 0 And Cells(i, 4).Value > 0 Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Nothing in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 7).Value <= 0 Then
Cells(i, 16).Value = "Complete: All in Stock"
Cells(i, 16).Interior.Color = rgbGreen
Cells(i, 16).Font.Color = rgbWhite
ElseIf Cells(i, 5).Value = 0 And Cells(i, 6) > 0 And Cells(i, 4).Value > 0 And Cells(i, 7).Value < Cells(i, 4).Value Then
Cells(i, 16).Value = "Incomplete: Nothing Ordered and Some in Stock"
Cells(i, 16).Interior.Color = rgbRed
Cells(i, 16).Font.Color = rgbWhite
End If
Next i
End If
'data validation for column k (unit cost)
If Not Application.Intersect(Target, Range("k8:k" & x)) Is Nothing Then
Dim Rng5 As Range
Set Rng5 = Range("K8:k" & x)
For Each Cell In Rng5
If Cell.Value < 0 Then
MsgBox "Please enter a positive number"
Cell.Select
Cell.Value = ""
End If
If Not IsNumeric(Cell.Value) Then
MsgBox "Please Enter a Numeric Value"
Cell.Select
Cell.Value = ""
End If
Next
End If
'data validation for column O (Actual Lead Time)
If Not Application.Intersect(Target, Range("o8:o" & x)) Is Nothing Then
Dim Rng6 As Range
Set Rng6 = Range("o8:o" & x)
For Each Cell In Rng6
If Cell.Value < 0 Then
MsgBox "Please enter a positive number"
Cell.Select
Cell.Value = ""
End If
If Not IsNumeric(Cell.Value) Then
MsgBox "Please Enter a Numeric Value"
Cell.Select
Cell.Value = ""
End If
Next
End If
'data validation for column E (Number Ordered)
If Not Application.Intersect(Target, Range("e8:e" & x)) Is Nothing Then
Dim Rng7 As Range
Set Rng7 = Range("e8:e" & x)
For Each Cell In Rng7
If Cell.Value < 0 Then
MsgBox "Please enter a positive number"
Cell.Select
Cell.Value = ""
End If
If Not IsNumeric(Cell.Value) Then
MsgBox "Please Enter a Numeric Value"
Cell.Select
Cell.Value = ""
End If
Next
End If
'data validation for column E (Number In Stock)
If Not Application.Intersect(Target, Range("f8:f" & x)) Is Nothing Then
Dim Rng8 As Range
Set Rng8 = Range("f8:f" & x)
For Each Cell In Rng8
If Cell.Value < 0 Then
MsgBox "Please enter a positive number"
Cell.Select
Cell.Value = ""
End If
If Not IsNumeric(Cell.Value) Then
MsgBox "Please Enter a Numeric Value"
Cell.Select
Cell.Value = ""
End If
Next
End If
'Determing delivery date status
'If Not Application.Intersect(Target, Range("r8:r" & x)) Is Nothing Or Not Application.Intersect(Target, Range("O3")) Is Nothing Then
'For i = 8 To x
'If (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Skid Mechanical" Or Cells(i, 10).Value = "Skid Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Kiosk Mechanical" Or Cells(i, 10).Value = "Kiosk Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'If (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value < (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbRed
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf (Cells(i, 10).Value = "Site Mechanical" Or Cells(i, 10).Value = "Site Electrical") And Cells(i, 18).Value > (Range("O3").Value - 14) And Cells(i, 18).Value > 0 Then
'Cells(i, 18).Interior.Color = rgbGreen
'Cells(i, 18).Font.Color = rgbWhite
'ElseIf Cells(i, 18).Value < 0 Then
'Cells(i, 18).Interior.ColorIndex = 0
'Cells(i, 18).Font.Color = rgbBlack
'End If
'
'
'Next i
'End If
For i = 1 To x
If Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Electrical" Then
Range("h" & i).Interior.Color = rgbDarkGreen
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("H" & i).Value = "Kiosk Mechanical" Then
Range("h" & i).Interior.Color = rgbYellow
Range("h" & i).Font.Color = rgbBlack
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Electrical" Then
Range("h" & i).Interior.Color = rgbBlue
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Skid Mechanical" Then
Range("h" & i).Interior.Color = rgbGrey
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Electrical" Then
Range("h" & i).Interior.Color = rgbPurple
Range("h" & i).Font.Color = rgbWhite
ElseIf Worksheets("Procurement Schedule").Range("h" & i).Value = "Site Mechanical" Then
Range("h" & i).Interior.Color = rgbLightGrey
Range("h" & i).Font.Color = rgbBlack
End If
Next i
'ThisWorkbook.Worksheets("Procurement Schedule").Protect userinterfaceonly:=True
Application.ScreenUpdating = True
End Sub