can this code be sped up?

sampson32 · Oct 21, 2005

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

‘*********************************************

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

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

hatman · Oct 21, 2005

Without spending a long time trying to parse out your entire routine, allow me to make a few observations and a few suggestions that I hope will help you move in a sensible direction:

It looks to me like you are applying your conditions to all rows that are populated. When in fact, the user can only change one cell at any given time. Since that cell exists in only one row, and all of your rules seem to exist in only one row at a time, why not simply process that row only.

Each action in a row also seems to be dependent upon the column, and really only results in one result for each possible action.

Remember that the Target object in the routine represents your selected cell. So you can do marvelous things with that. Here is how I usually procedd with something like this... again, only general case, but you can use this to refine your specific needs:

Code:

xcol = Target.Column
xrow = Target.row

I like to put this right in the beginning my routine, now I can start to evaluate things based on this info:

Code:

select case xcol

    case 2  'selected cell is in column B

           do something based on this cell, see if it is blank or not, change colors, whatever.

    case 3 'selected cell is in column C

           do something based on ONLY THIS cell

    case n 'make a case for each column you want to examine.

Don't forget, you can always do things in other cells bay saying range("G" & xrow).value = stuff...

See what you can do tto convert your code to this sort of scheme. Feel free to check back with specific questions. The major thing you need to concentrate on, in my humble opinion, is changing your approach to focus on the SINGLE CELL that is being manipulated, and focus on how to break things down to simple rules to avoid processing any other cells that are not related to the current action. Otherwise, you end up processing the same cells repeatedly for no reason.

Good luck.[/code]

Von Pookie · Oct 21, 2005

Have you tried conditional formatting?

For F3:
Condition 1:

Formula is | =ISBLANK($F3)
set the pattern color to "no color"

Condition 2:
Formula is | =AND($F3< TODAY(),$G3="")
set the pattern color to red.

H3:
Condition 1:
Formula is | =AND(NOT(ISBLANK($G3)),$G3< TODAY(),$H3="")
set the pattern color to red

You should then be able to copy the formatting to the other rows and the formulas should update accordingly.

sampson32 · Oct 24, 2005

Thanks to both for the ideas.

Hatman - That’s exactly what I need to do… I’ll play around with it and see what I can come up with – Although it will take me awhile to figure it out – If I run into a problem don’t be surprised if I give you a shout.

Kristy – I attempted conditional formatting first (btw – your formulas are much better than what I was playing with) but this workbook is big! I need to put this format in the cells of 45000 rows and once I get all cells formatted as needed and the workbook is closed for some reason it takes forever (almost 45 seconds) for the sheet to open – prior to that it’s just white.

Thanks again,

Vinnie

Von Pookie · Oct 24, 2005

Just cause I have the time to kill at the moment, I tried working up some code. I came up with this, which runs the code depending on the column of the changed cell. It gets a little tricky, because you have to be a bit redundant (if you change G, have to check the value of F all over again, etc.):

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'if more than 1 cell changed, do not run macro
If Target.Count > 1 Then Exit Sub

'if changed cell was not in column F, G or H, do not run macro
If Intersect(Target, Columns("F:H")) Is Nothing Then Exit Sub

'runs code according to column the changed cell is in
With Target
 Select Case .Column
 Case Is = 6 'column F
 Select Case .Value
 'if value of changed cell is blank or _
 greaterthan/equal to current date
 Case Is = "", Is >= Date
 'do not color column F cell
 .Interior.ColorIndex = xlNone
 'if value of changed cell is older than 1 day and _
 cell in column G of same row is blank
 Case Is < Date And Cells(Target.Row, "G") = ""
 'color column F cell red
 .Interior.ColorIndex = 3
 End Select
 Case Is = 7 'column G
 Select Case .Value
 'if value of changed cell is blank
 Case Is = ""
 'check the value of column F cell for same row
 With Cells(Target.Row, "F")
 If .Value = "" Then 'if blank, do not color column F cell
 .Interior.ColorIndex = xlNone
 'otherwise if date in column F cell is older than 1 day
 ElseIf .Value < Date Then
 'color column F cell red
 .Interior.ColorIndex = 3
 End If
 End With
 'no color in column H cell
 Cells(Target.Row, "H").Interior.ColorIndex = xlNone
 Case Else 'if column G cell is not blank
 'no color in column F cell
 Cells(Target.Row, "F").Interior.ColorIndex = xlNone
 'if cell is older than 1 day and column H cell is blank
 If .Value < Date And Cells(Target.Row, "H") = "" Then
 'color column H cell red
 Cells(Target.Row, "H").Interior.ColorIndex = 3
 Else
 'otherwise no color in column H cell
 Cells(Target.Row, "H").Interior.ColorIndex = xlNone
 End If
 End Select
 Case Is = 8 'column H
 'if column H cell is blank
 If .Value = "" Then
 'check value of column G cell
 Select Case Cells(Target.Row, "G").Value
 Case Is = "" 'if blank
 'no color in column H cell
 .Interior.ColorIndex = xlNone
 Case Is < Date 'if older than 1 day
 'color column H cell red
 .Interior.ColorIndex = 3
 End Select
 Else 'otherwise
 'no color in column H cell
 .Interior.ColorIndex = xlNone
 End If
 End Select
End With

End Sub

sampson32 · Oct 24, 2005

Kristy –

What a pleasant surprise! Thank you!

Vinnie

can this code be sped up?

sampson32

Active Member

Excel Facts

hatman

Well-known Member

Von Pookie

MrExcel MVP

sampson32

Active Member

Von Pookie

MrExcel MVP

sampson32

Active Member

Similar threads

Forum statistics

Share this page

can this code be sped up?

sampson32

Active Member

Excel Facts

hatman

Well-known Member

Von Pookie

MrExcel MVP

sampson32

Active Member

Von Pookie

MrExcel MVP

sampson32

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock