Assistance in improving spreed on a mammoth spreadsheet

P

Pauljj

Well-known Member
Joined
Mar 28, 2004
Messages
2,047
I have a spreadsheet which is 'huge' thousands of calculations and using some quite involved formulas across about 20 sheets. In order to improve performance I, a few years ago, switched calculations on this spreadsheet to manual and set VB up to calculate applicable sheets when certain cells were selected. It seems to be slowing down again and this is probably my own fault as I make the spreadsheet more and more complex.

My question is, on one sheet where I use a coding to calculate as follows

Private Sub Worksheet_Change(ByVal Target As Range)

I have users who have to select from a drop down in 8 different cells, is there any way I can see if these cells are selected/changed that excel DOES NOT calculate the sheet ?
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
I understand what you mean but am unsure then where I am going wrong, my code is below, not sure if that helps ??


Private Sub Worksheet_Change(ByVal Target As Range)

Dim n As Long, lngIndex As Long, fngindex As Long


'clear contents causes a change event procedure to fire, which will continue endlessly
'unless enable events are disabled

If Range("C5") = "SDK*" Then

Sheets("Charts").Range("VAL1CELL") = "SDK UK"


Else

Sheets("Charts").Range("VAL1CELL") = Range("C5")

End If

Sheets("Charts").Range("VAL2CELL") = Sheets("Charts").Range("Y$41")

If Not Intersect(Target, Me.Range("$C$5")) Is Nothing Then Me.Calculate
If Not Intersect(Target, Me.Range("$U$3")) Is Nothing Then Me.Calculate
If Not Intersect(Target, Me.Range("$S$36")) Is Nothing Then Me.Calculate


If Range("Y7").Value = "True" Then

MsgBox " Please contact Lorraine or Marcus before submitting", 0, "Probabtionary Consultant"

End If

If ActiveCell.Address = "$U$3" Then Me.Calculate

Application.EnableEvents = False
If Not Intersect(Target, Me.Range("$C$5")) Is Nothing Then Me.Calculate
If ActiveCell.Address = "$C$5" Then Range("U$3") = Range("c$8")
Me.Calculate
If Not Intersect(Target, Me.Range("$U$3")) Is Nothing Then Range("U10, U12, U16, U18, U22, U25, U27, U29, S36").ClearContents

Application.ScreenUpdating = False


For n = 7 To 125

If Cells(n, "A").Value = 1 Then
'orange
lngIndex = 45
fngindex = 1

ElseIf Cells(n, "H").Value = "Reached" Then
'yellow
lngIndex = 6
fngindex = 1

ElseIf Cells(n, "I").Value = 1 Then
'green
lngIndex = 4
fngindex = 1

ElseIf Cells(n, "G").Value Like "6 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "7 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "8 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "9 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "10 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "11 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "12 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "13 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "14 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "15 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "16 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf Cells(n, "G").Value = "17 Months" Then
'Purple
lngIndex = 13
fngindex = 2

ElseIf IsDate(Cells(n, "G").Value) Then
'Red
lngIndex = 3
fngindex = 1

ElseIf Cells(n, "A").Value = 2 Then
'grey
lngIndex = 48
fngindex = 1

Else
' no colour
lngIndex = xlColorIndexNone
fngindex = 1

End If

Range(Cells(n, "C"), Cells(n, "G")).Interior.ColorIndex = lngIndex
Range(Cells(n, "C"), Cells(n, "G")).Font.ColorIndex = fngindex

Next n

If Not Intersect(Target, Me.Range("$u$10")) Is Nothing Then

If Range("Y3").Value = "FALSE2" Then

CONS = Range("U3")

MsgBox CONS & " has been held back for disciplinary purposes, please contact Personnel"

Range("U10").ClearContents


If Not Intersect(Target, Me.Range("$s$36")) Is Nothing Then

If Range("Y7").Value = "True" Then

MsgBox " Test"

Exit Sub

End If
End If
End If
End If


Me.Calculate

Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub
 
Upvote 0
These lines are checking that the cell that was changed was one of the ones that you are monitoring:

Code: 
If Not Intersect(Target, Me.Range("$C$5")) Is Nothing Then Me.Calculate
If Not Intersect(Target, Me.Range("$U$3")) Is Nothing Then Me.Calculate
If Not Intersect(Target, Me.Range("$S$36")) Is Nothing Then Me.Calculate
 
Upvote 0
Apologies Andrew I am not sure I understand what you mean

The cells I want the user to be able to changed without any calculation taking part are

U10
U12
U16
U18
U22
U25
U27
U29
 
Upvote 0
I dont have anything specific to do that, what is happening is, everytime one of those cells is changed, excel re-calculates when I need it not to
 
Upvote 0
I've hughlighted the 2 lines that are causing that:

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long, lngIndex As Long, fngindex As Long, CONS
'   clear contents causes a change event procedure to fire, which will continue endlessly
'   unless enable events are disabled
    If Range("C5") = "SDK*" Then
        Sheets("Charts").Range("VAL1CELL") = "SDK UK"
    Else
        Sheets("Charts").Range("VAL1CELL") = Range("C5")
    End If
    Sheets("Charts").Range("VAL2CELL") = Sheets("Charts").Range("Y$41")
    If Not Intersect(Target, Me.Range("$C$5")) Is Nothing Then Me.Calculate
    If Not Intersect(Target, Me.Range("$U$3")) Is Nothing Then Me.Calculate
    If Not Intersect(Target, Me.Range("$S$36")) Is Nothing Then Me.Calculate
    If Range("Y7").Value = "True" Then
        MsgBox " Please contact Lorraine or Marcus before submitting", 0, "Probabtionary Consultant"
    End If
    If ActiveCell.Address = "$U$3" Then Me.Calculate
    Application.EnableEvents = False
    If Not Intersect(Target, Me.Range("$C$5")) Is Nothing Then Me.Calculate
    If ActiveCell.Address = "$C$5" Then Range("U$3") = Range("c$8")
    Me.Calculate
    If Not Intersect(Target, Me.Range("$U$3")) Is Nothing Then Range("U10, U12, U16, U18, U22, U25, U27, U29, S36").ClearContents
    Application.ScreenUpdating = False
    For n = 7 To 125
        If Cells(n, "A").Value = 1 Then
'           orange
            lngIndex = 45
            fngindex = 1
        ElseIf Cells(n, "H").Value = "Reached" Then
'           yellow
            lngIndex = 6
            fngindex = 1
        ElseIf Cells(n, "I").Value = 1 Then
'           green
            lngIndex = 4
            fngindex = 1
        ElseIf Cells(n, "G").Value Like "6 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "7 Months" Then
'           Purple
            lngIndex = 1
            fngindex = 2
        ElseIf Cells(n, "G").Value = "8 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "9 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "10 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "11 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "12 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "13 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "14 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "15 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "16 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf Cells(n, "G").Value = "17 Months" Then
'           Purple
            lngIndex = 13
            fngindex = 2
        ElseIf IsDate(Cells(n, "G").Value) Then
'           Red
            lngIndex = 3
            fngindex = 1
        ElseIf Cells(n, "A").Value = 2 Then
'           grey
            lngIndex = 48
            fngindex = 1
        Else
'       no colour
            lngIndex = xlColorIndexNone
            fngindex = 1
        End If
        Range(Cells(n, "C"), Cells(n, "G")).Interior.ColorIndex = lngIndex
        Range(Cells(n, "C"), Cells(n, "G")).Font.ColorIndex = fngindex
    Next n
    If Not Intersect(Target, Me.Range("$u$10")) Is Nothing Then
        If Range("Y3").Value = "FALSE2" Then
            CONS = Range("U3")
            MsgBox CONS & " has been held back for disciplinary purposes, please contact Personnel"
            Range("U10").ClearContents
            If Not Intersect(Target, Me.Range("$s$36")) Is Nothing Then
                If Range("Y7").Value = "True" Then
                    MsgBox " Test"
                    Exit Sub
                End If
            End If
        End If
    End If
    Me.Calculate
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

In future when posting code please use code tags so that it is indented and easier to read (assuming it's already indented in your project). If you don't know how to do that see:

http://www.mrexcel.com/forum/misc.php?do=bbcode#code
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Excel very slow
Replies
5
Views
597
Alex Blakenburg
A
E
  • Solved
Performance issue using a combination of dropdowns & lookups
Replies
9
Views
654
Akuini
Akuini
B
  • Question Question
Excel Table Lookup with OR Conditions and Multiple Columns
Replies
1
Views
127
BenW71
B
B
  • Question Question
Function (using VBA macro) Runs Too Frequently
Replies
4
Views
378
Alex Blakenburg
A
G
  • Question Question
Improve calculation speed for this worksheet with INDIRECT/FILTER functions
Replies
0
Views
464
GeneBF
G

Forum statistics

Threads
1,224,606
Messages
6,179,862
Members
452,948
Latest member
UsmanAli786

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