Slow running macro

[Phil Payne]

I have worksheet macro that takes a very long time to run. There are only 47 target cells and it takes up to 30 seconds to complete!
Can anyone see how I can improve on this?

Private Sub Worksheet_Change(ByVal Target As Range)
' This code checks for a change of Status in the Current Status column and
' on change sets (adjacent) cells' 'interior' and 'font ' colours according to table "rCodes".
    If Target.Count > 1 Then Exit Sub
    Dim rCell As Range
    Dim rCodes As Range
    Dim rRow As Range
    Dim vMatch
    Dim LastRow As Long
    LastRow = Range("A65536").End(xlUp).Row
    Set rCodes = Range("g6:g16")
    If (Target.Column >= 1) And (Target.Column <= Range("D1").Column) And (Target.Row <= LastRow) Then
        If Len(Target.Value) > 0 Then
            On Error Resume Next
            vMatch = Application.Match(Target.Value, rCodes, 0)
            If IsError(vMatch) Then
               'DO NOTHING
            Else
                With Target.Cells
                     .Offset(0, -1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                     .Offset(0, -1).Font.Color = rCodes.Cells(vMatch).Font.Color
                End With
            End If
        End If
    End If
End Sub

Thanks in anticipation.
Phil

 

[Rick Rothstein]

Thanks for your prompt responses gents.

I should have provided the complete code which is now below. Hope this helps. I am being kicked off our PC now but will provide more details later if required.

The code helps, but it does not address the questions I asked in Message #2.

 

[ParamRay]

.
.

Phil, you could try turning off automatic calculation mode and see if it makes a difference to the running time.

Application.Calculation = xlCalculationManual

'
' code here
'
'

Application.Calculation = xlCalculationAutomatic

 

[Phil Payne]

The code helps, but it does not address the questions I asked in Message #2.

All, sorry for my delay in reply. I very much appreciate your interest and help.

Rick,
I'll try and better describe what's happening using the image below.
Column A is contains info numbers only, Column B is a basic link with the Data Sheet
Column C is a basic link with the Data Sheet, col D responds to the change initiated by the ComboBox and col E is a basic Vlookup using Col C
(Column's C, D and E obtain their data from the 'Data Sheet' worksheet one way or another. )
The ComboBox allows us to select from a list of work sites elsewhere within its worksheet.
Columns G & H form the status codes reference table.


On selecting a 'Site' using the ComboBox, column D is populated with the required data then the VBA code uses the table G6 to H15 (H16 in the latest version) so that on each change of 'Site' and therefore status in column D it sets the interior and font colours of the cells in col C to match status table.

Populating the data is instant, setting the colours can take up to 30 seconds (47 rows)

Sorry again, tried to insert an image from my PC but system would not let me browse to the image file and a direct copy/paste presented gobbledegook on post preview so I removed it.

I hope the description alone helps!


Phil

 

[Phil Payne]

The code helps, but it does not address the questions I asked in Message #2.

Hello all,

Can I supply any further details that might help?

Sadly I cannot load an image!

Thanks.

 

[Phil Payne]

Hello Rick,

Sorry for the delay in reply.

I see what you're driving at. I'm a novice at this as youve probably guessed.

I had code that worked well elsewhere doing something similar so I copied it, fudged it, and got it to work (sort of) and here we are.

After reading your replies again, I played a little with the code and got to this point:-

Private Sub Worksheet_Change(ByVal Target As Range)
' This code checks for a change of Status in the Current Status column and on change fills cells
' in Themes column with appropriate colour from code/decription table (G5:H16).
    If Target.Count > 1 Then Exit Sub
    Dim rCell As Range
    Dim rCodes As Range
    Dim rRow As Range
    Dim vMatch
    Set rCodes = Range("g6:g16")
    If (Target.Column = 4) Then
        If Len(Target.Value) > 0 Then
'            On Error Resume Next
            vMatch = Application.Match(Target.Value, rCodes, 0)
            If IsError(vMatch) Then
                With Target.Cells
                     .Offset(0, -1).Font.ColorIndex = xlAutomatic
                     .Offset(0, -1).Interior.Color = xlNone
                End With
            Else
                With Target.Cells
                     .Offset(0, -1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                     .Offset(0, -1).Font.Color = rCodes.Cells(vMatch).Font.Color
                End With
            End If
        End If
    End If
End Sub

Unfortunately, although it worked, it was still extremely slow i.e. same as before.

I hope you have some advice that will help me resolve this.

Thanks for your time and effort on my behalf.

Phil

The code helps, but it does not address the questions I asked in Message #2.

 

[Rick Rothstein]

Whatever is slowing up your system, my guess is it is somewhere else in your project... the code you posted works pretty much instantaneously on my system.

 

[Phil Payne]

Thanks Eric,

That's a scary prospect!

I have three worksheets that use similar code. Is possible e.g. that the way I describe ranges is causing confusion o conflict?

Have you had a similar problem in the past?

Thanks for your advice.

Regards,

Phil.

 

[Rick Rothstein]

Thanks Eric,

That's a scary prospect!

I have three worksheets that use similar code. Is possible e.g. that the way I describe ranges is causing confusion o conflict?

I presume you directed your comment to me... if so, I would point out that my name is Rick, not Eric.

It is kind of hard to offer a solution to a problem I can't reproduce. While I don't have a lot of time to devote to this, if your data is all self-contained within the workbook, then if you send me a copy of your workbook, I would be happy to look quickly to see if I can identify the problem area for you. My email address is...

rick DOT news AT verizon DOT net

 

[Phil Payne]

Hello Rick, (apologies for getting your name wrong earlier)


Thanks for your very kind offer but I'm unable to send you my whole workbook!


Do you think this may have a bearing on the problem:-

In my code (see #7) you'll see I have a gap between the code sub that returns the status value and the code sub that determines the cell and font colours. This is where a command button sub was placed.

As the 'status' and 'colour' subs work in concert I thought I would combine them by moving the command button to the end of the code and deleting End Sub and Sub lines in the body of what was left.

On running I got the message "compile error - variable not found" on line "If target.Count > 1 Then Exit Sub" in what was the 'colours' sub

This was never a 'visible' problem before I moved the command button so why now?

Thanks for taking the time to help.

Phil

 

[Phil Payne]

Hi again Rick,

I've just noticed that after entering a value in an empty cell on the worksheet and hitting return the cursor jumps up to cell A1

I removed 'ActiveSheet.Range("A1").Select from the code!

No change to performance though.


Phil