Please take a look at the code below:
Since it is associated with the sheet change event it runs through the entire code with each entry in the spreadsheet.
Is there any way to speed this code up or make to run faster?
If anyone can see where this code could be put together better please let me know.
Any ideas appreciated!
Thanks,
Vinnie
‘*********************************************
This code operates as follows:
S1- If the date entered into (F) column “should receive” is older than 1 day and the (G) column “received date” is null then the cell in column (F) is shaded red.
S2 and S3 – If the dates in S1 are updated the shading is removed
S4 – If the date entered into (G) column “received date” is older than 1 day and (H) column “Great Plains received date” is null then the cell in column (H) is shaded red
S5 and S6 – If the date in (G) is removed or a date is entered into (H) shading is removed
‘**********************************************************
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
‘***************************************
S1
‘***************************************
Dim i As Long, myLastRow As Long
Dim Today
Today = Date
myLastRow = Range("D65536").End(xlUp).Row
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value = "" Then
If Range("F" & i).Value< Today Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = 3
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
‘*********************************************
S2 and S3
'****** If ETA Date Updated than Color Removed ****
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value = "" Then
If Range("F" & i).Value >= Today Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
'****** If Received Date Entered than color removed ****
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value<> "" Then
If Range("F" & i).Value<> "" Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
‘*********************************************
S4
‘*********************************************
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value<> "" Then 'received date
If Range("G" & i).Value< Today Then
If Range("H" & i).Value = "" Then 'GP received
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = 3
Sheets(1).Protect Password:="protected"
End If
End If
End If
End If
Next i
‘****************************************
S5 and S6
‘****************************************
For i = 3 To myLastRow
If Range("G" & i).Value = "" Then 'received date
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
Next i
For i = 3 To myLastRow
If Range("H" & i).Value<> "" Then 'GP received
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
Next i
End Sub
Since it is associated with the sheet change event it runs through the entire code with each entry in the spreadsheet.
Is there any way to speed this code up or make to run faster?
If anyone can see where this code could be put together better please let me know.
Any ideas appreciated!
Thanks,
Vinnie
‘*********************************************
Copy of w Macro PO_Log v1.2.xls | |||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | |||
1 | PO# | Vendor | Branch | Item(s) | Date | Should | Date | Great Plains - Dates | A/P Processed | ||||
2 | Ordered | Receive | Received | Received | Entered | Sent To A/P | |||||||
3 | 21011 | Nucor | Kiss | #5 20' GR40 | 11/23/2004 | 11/29/2004 | |||||||
PO Log |
This code operates as follows:
S1- If the date entered into (F) column “should receive” is older than 1 day and the (G) column “received date” is null then the cell in column (F) is shaded red.
S2 and S3 – If the dates in S1 are updated the shading is removed
S4 – If the date entered into (G) column “received date” is older than 1 day and (H) column “Great Plains received date” is null then the cell in column (H) is shaded red
S5 and S6 – If the date in (G) is removed or a date is entered into (H) shading is removed
‘**********************************************************
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
‘***************************************
S1
‘***************************************
Dim i As Long, myLastRow As Long
Dim Today
Today = Date
myLastRow = Range("D65536").End(xlUp).Row
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value = "" Then
If Range("F" & i).Value< Today Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = 3
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
‘*********************************************
S2 and S3
'****** If ETA Date Updated than Color Removed ****
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value = "" Then
If Range("F" & i).Value >= Today Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
'****** If Received Date Entered than color removed ****
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value<> "" Then
If Range("F" & i).Value<> "" Then
Sheets(1).Unprotect Password:="protected"
Range("F" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
End If
End If
Next i
‘*********************************************
S4
‘*********************************************
For i = 3 To myLastRow
If Range("F" & i).Value<> "" Then
If Range("G" & i).Value<> "" Then 'received date
If Range("G" & i).Value< Today Then
If Range("H" & i).Value = "" Then 'GP received
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = 3
Sheets(1).Protect Password:="protected"
End If
End If
End If
End If
Next i
‘****************************************
S5 and S6
‘****************************************
For i = 3 To myLastRow
If Range("G" & i).Value = "" Then 'received date
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
Next i
For i = 3 To myLastRow
If Range("H" & i).Value<> "" Then 'GP received
Sheets(1).Unprotect Password:="protected"
Range("G" & i).Interior.ColorIndex = -4142
Sheets(1).Protect Password:="protected"
End If
Next i
End Sub