Private Sub Worksheet_Calculate () crashing excel

Question

I am struggling with a problem with Worksheet_Calculate(). As suggested here Run Sub procedure with IF() statement in cell I have tried to translate an excel IF() statement in to VBA in the Worksheet_Calculate() as the cells will be activated with dynamic formula. However, when the specific formula in VBA meets the condition the code that is meant to run crashes excel. If I run the code in the VBE as a separate sub it runs perfectly and executes correctly as what is needed. Below is the code, any help is greatly appreciated.

Private Sub Worksheet_Calculate()

Dim rng As Range
Dim mainSheet As Worksheet

Set mainSheet = Worksheets("Sheet1")

If (mainSheet.Range("D2").Value = "ABOVE" And mainSheet.Range("F2").Value > mainSheet.Range("E2").Value And mainSheet.Range("H2").Value = "YES" And mainSheet.Range("I2").Value = "1") Or (mainSheet.Range("D2").Value = "BELOW" And mainSheet.Range("F2").Value < mainSheet.Range("E2").Value And mainSheet.Range("H2").Value = "YES" And mainSheet.Range("I2").Value = "1") Then

    'Disable events so as not to overload the worksheet calculate - as the worksheet is calculating dont change/ delete
    Application.EnableEvents = False

    'enter and copy data
    Set rng = Sheets("Sheet3").Range("A:A").End(xlDown)

    rng.Offset(1, 0) = Format(Now(), "dd/mm/yyyy")
    rng.Offset(1, 1) = Format(Now(), "ddd")
    rng.Offset(1, 2) = Format(Now(), "hh:nn")
    rng.Offset(1, 3) = Sheets("Sheet1").Range("C2")
    rng.Offset(1, 4) = Sheets("Sheet1").Range("A2")
    rng.Offset(1, 5) = Sheets("Sheet1").Range("E2")

    'delete row information
    Worksheets("Sheet1").Range("A2").ClearContents
    Worksheets("Sheet1").Range("C2:E2").ClearContents
    Worksheets("Sheet1").Range("G2:H2").ClearContents

    're-sort colums
    Application.Run "SortByMarket"

    Application.ScreenUpdating = True
    'turn back on events
    Application.EnableEvents = True

 End If

Also, this is obviously not the most efficient way possible to code this so any input/ advice is welcome.

BrendanOtherwhyz · Accepted Answer · 2018-06-24T10:06:58.047

0

I think the problem is that every time you change a cell Worksheet_Calculate will be called and interrupt itself.

Use this at that start of your sub:

Application.EnableEvents = False

and

Application.EnableEevents = True

at the end.

Tips:

You should reduce the number of times you look for the last row in a column with value in it by just searching for it once and saving it as a range variable.

Dim rng As Range

set rng = Sheets("Sheet3").Range("A:A").End(xlDown)

Also I wouldn't bother using copy, just assign the value to the destination cell as you have done with the timestamp values.

It should look something link this:

'enter and copy data
rng.Offset(1, 0) = Format(Now(), "dd/mm/yyyy")
rng.Offset(1, 1) = Format(Now(), "ddd")
rng.Offset(1, 2) = Format(Now(), "hh:nn")
rng.Offset(1, 3) = Sheets("Sheet1").Range("C2")
rng.Offset(1, 4) = Sheets("Sheet1").Range("A2")
rng.Offset(1, 5) = Sheets("Sheet1").Range("E2")

edited Jun 24 '18 at 10:06

answered Jun 24 '18 at 09:02

BrendanOtherwhyz

471
4
9

Hi Brendan, thank you for your response. Makes complete sense what you're saying, however, I keep getting this error: Run-time error '2147417848 (80010108)' Method 'Range' of object '_Worksheet' failed and the Set rng = line gets highlighted..? – Dean Jun 24 '18 at 09:50
Realised the problem after you posted the error message. Please see edit, taken from https://stackoverflow.com/questions/42120012/method-range-of-object-worksheet-failed-error-2147417848-80010108#42120651 – BrendanOtherwhyz Jun 24 '18 at 10:08
Yes, thank you for your help Brendan. Would you know why, based on the above, that its not entering the information in the last new line in Sheet 3? It pastes over the last line of data, instead of on the next new line? – Dean Jun 24 '18 at 10:38
Maybe you could post your code and a screenshot of your sheet/s. That may help, otherwise check your offset row is 1. – BrendanOtherwhyz Jun 24 '18 at 11:26
Its working on my end. Do all columns in sheet3 have same number of non-blank cells?If so you could try offsetting row by 2, although this shouldn’t be neccessary. Its hard to tell without seeing what you can see, try debugging - put a line break in on the set rng line, this may help. – BrendanOtherwhyz Jun 24 '18 at 21:46
Thanks for the help @Brendan.H. It seems the problem was that on Sheet3 I was pasting the data in to a table, and for some reason that was just pasting over the data. but now that I have removed the table and just have normal cells it seems to be working perfectly. – Dean Jun 25 '18 at 09:46

Private Sub Worksheet_Calculate () crashing excel

1 Answers1