简体   繁体   中英

Excel crashes when macro is run from VBA interface, but works when using a button

I have a macro that takes different ranges, performs calculations with values in them, and then copies the value to a cell to be available for use to formulas in the worksheet. I want this macro to run when values in certain ranges are modified. I use this same code in different worksheets, where I initially placed an ActiveX button. The problem is that when I put the macro in a worksheet_calculate or Worksheet_SelectionChange Excel crashes alltogether. At first I assumed I was causing infinite iterations, but after using EventEnable = FALSE and EnableCalculations = FALSE to avoid that behavior Excel still crashed. I erased the macros in SelectionChange and Calculate, and I further inspected the issue and found that when the macro is run from the VBA interface Excel also crashes, but it works with the ActiveX button in the worksheets that makes reference to the macro. I just can't seem to find what is wrong with the code, and why it runs perfectly when accessed through the button but crashes when run from the VBA interface.

Here is the code, please help me find what is wrong, or what I can I try so that it runs from VBA because calling it or running it from the interface will crash Excel as of now.

Sub performCalculations()
Dim revenue As Double
Dim expenses As Double
Dim i As Integer
Dim j As Integer
Dim count As Integer
Dim aConst As Double
Dim tempConst As Long
Dim bla As Range
Dim curve As Range
Dim price As Range
Dim finalOut As Range
Dim a As Double
Dim tempString As String


Set bla = ActiveWorkbook.ActiveSheet.Range("D16:D75")
Set curve = ActiveWorkbook.ActiveSheet.Range("G2:WH11")
Set price = ActiveWorkbook.ActiveSheet.Range("G162:WH164")
Set finalOut = ActiveWorkbook.ActiveSheet.Range("G83:WH141")
tempString = ActiveWorkbook.ActiveSheet.Name
tempString = Left(tempString, InStr(1, tempString, " ", vbTextCompare) - 1)
a = ActiveWorkbook.Sheets(tempString).Cells(10, 8).Value
aConst = a / 1000


For i = 1 To bla.Rows.count
    count = 1
    For j = 1 To curve.Columns.count
        If j < i Then
            finalOut.Cells(i, j) = 0
        Else
            If bla.Cells(i, 1) = 0 Then
                finalOut.Cells(i, j) = 0
            Else
                tempConst = curve.Cells(2, count) * aConst * price.Cells(2, j)
                revenue = bla.Cells(i, 1) * (curve.Cells(1, count) * price.Cells(1, j) + curve.Cells(3, count) * price.Cells(3, j))
                expenses = bla.Cells(i, 1) * curve.Cells(4, count) + bla.Cells(i, 1) * curve.Cells(5, count) + bla.Cells(i, 1) * _
                    curve.Cells(6, count) + bla.Cells(i, 1) * curve.Cells(7, count) + bla.Cells(i, 1) * curve.Cells(10, count)
                expenses = expenses + revenue * curve.Cells(9, count) + tempConst * curve.Cells(8, count)
                revenue = revenue + tempConst
                finalOut(i, j) = revenue - expenses
                count = count + 1
            End If
            If i > 1 Then
                finalOut.Cells(i, j) = finalOut.Cells(i, j) + finalOut.Cells(i - 1, j)
            End If
        End If
    Next j
Next i


End Sub

I am running Excel 2013, and Windows 7 Professional

I am not sure if this is the final answer for your problem but one thing could be affecting you macro, the use of Active Objects such as ActiveWorkbook, ActiveSheet and so on.

My advice for you is to reference the objects you have to use so that if your excel file is not selected or if you select the wrong worksheet, the code still works. To do that, please check the example below:

Dim workingSheet as Worksheet
Dim auxWorksheet as Worksheet

Set workingSheet = ThisWorkbook.Worksheets("The name of the worksheet here")
Set auxWorksheet = ThisWorkbook.Worksheets(tempString)

Set bla = workingSheet.Range("D16:D75")
Set curve = workingSheet.Range("G2:WH11")
Set price = workingSheet.Range("G162:WH164")
Set finalOut = workingSheet.Range("G83:WH141")
tempString = workingSheet.Name
a = auxWorksheet.Cells(10, 8).Value

Please give it a try and give some feedback so that if it does not work, I can keep trying to help you.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM