Calculating Percentage difference VBA Excel facing RunTime Error 91!

nan0168

New Member
Joined
Feb 12, 2020
Messages
8
Office Version
  1. 365
Platform
  1. MacOS
While the percentage difference works for current month vs previous monthly, and vs previous year without issues for the 40 +sheets within the workbook, i experience runtime error 91 when using current month vs closest quarterly number calculation. Attached is the screenshot for reference. I'm trying to speed up the code and make sure it runs without any hiccups.
Screen Shot 2020-02-15 at 11.39.35 AM.png



VBA Code:
Sub VarCalc()



Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.StatusBar = False



For i = 1 To Sheets.Count



    pos = Sheets(i).Index

    Sheets(pos).Activate

    With ActiveSheet

   

   If Len(Sheets(i).Name) < 5 Then



Cells.Find(What:="year", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

       

       

    Cells.Find(What:="month", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-3]/RC[-4])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-3]/RC[-4])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))



    dcolvar = Cells(1, Columns.Count).End(xlToLeft).Column

   

    If dcolvar Like "2" Or dcolvar Like "4" Or dcolvar Like "7" Or dcolvar Like "10" Then

        Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

   

    Else

    If dcolvar Like "3" Or dcolvar Like "5" Or dcolvar Like "8" Or dcolvar Like "11" Then

    Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

   

    Else

   

    Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))



            End If

   

        End If



End If



 End With



    Next i



Exit Sub



Application.Calculation = xlAutomatic

Application.ScreenUpdating = True

Application.StatusBar = True



End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Which line is causing the error?
VBA Code:
Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

This line is causing issues after calculation of 10 out of 44 sheets
 
Upvote 0
That will be down to nothing being found and trying to activate an invalid range.

Using Activate, Select, etc. is always going to make coding a headache, you're better of avoiding it by defining ranges and sheets as variables, then working with them without activating.

VBA Code:
Dim qtrFound As Range
Set qtrFound = Sheets(i).Cells.Find(What:="year", After:=ActiveCell, LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _ 
        MatchCase:=False, SearchFormat:=False)
If Not qtrFound Is Nothing Then
    ' do some stuff based on qtrFound
Else
    ' do nothing
End If
Note that Else is not required, I've just left it in to show the method.
 
Upvote 0
Thanks John for that comment; The only issue is inputting the next part of the code after this as I've these 3 conditions here : so it'll select current month against the closest quarter (here Dec vs Sept, if March it'd be against Dec, and so on.
Lastly in order to skip some cells, i had the activate and select.
Screen Shot 2020-02-16 at 10.55.51 AM.png


VBA Code:
    dcolvar = Cells(1, Columns.Count).End(xlToLeft).Column

   

    If dcolvar Like "2" Or dcolvar Like "4" Or dcolvar Like "7" Or dcolvar Like "10" Then

        Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

   

    Else

    If dcolvar Like "3" Or dcolvar Like "5" Or dcolvar Like "8" Or dcolvar Like "11" Then

    Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

   

    Else

   

    Cells.Find(What:="qtr", After:=ActiveCell, LookIn:=xlValues, LookAt:= _

        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate

    ActiveCell.Offset(2).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))

    ActiveCell.Offset(5).Select

    ActiveCell.FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"

    Selection.AutoFill Destination:=Range(ActiveCell, ActiveCell.End(xlDown))
 
Upvote 0
That wouldn't be an issue, here's your entire code from post 1 re-written without Select or Activate.

To prevent loss of data in the event of errors, please test the code on a copy of your file, not the original.

One concern that I have is the use of End(xlDown) I can see no data below the headings in your screen capture in post 1, which effectively means that the formulas will be filled down for over 1 million rows, not just the ones that have data in adjacent columns.

VBA Code:
Option Explicit
Sub VarCalc()
Dim dcolvar As Long
Dim ws As Worksheet
Dim vFound
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

For Each ws In Worksheets
    If Len(ws.Name) < 5 Then
        Set vFound = ws.Cells.Find("year", ActiveCell, xlValues, xlPart, xlByColumns, xlNext, False, False)
        
        If Not vFound Is Nothing Then
            With vFound
                Range(.Offset(2), .Offset(2).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"
                Range(.Offset(5), .Offset(5).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"
            End With
        End If
   
        Set vFound = Cells.Find("month", ActiveCell, xlValues, xlPart, xlByColumns, xlNext, False, False)

        If Not vFound Is Nothing Then
            With vFound
                Range(.Offset(2), .Offset(2).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-3]/RC[-4])-1,0)"
                Range(.Offset(5), .Offset(5).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-3]/RC[-4])-1,0)"
            End With
        End If
    
        dcolvar = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

        Set vFound = Cells.Find("month", ActiveCell, xlValues, xlPart, xlByColumns, xlNext, False, False)
    
        If Not vFound Is Nothing Then
        
            Select Case dcolvar
                Case 2, 4, 7, 10
                    With vFound
                        Range(.Offset(2), .Offset(2).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"
                        Range(.Offset(5), .Offset(5).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"
                    End With
                Case 3, 5, 8, 11
                    With vFound
                        Range(.Offset(2), .Offset(2).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"
                        Range(.Offset(5), .Offset(5).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"
                    End With
                Case Else
                    With vFound
                        Range(.Offset(2), .Offset(2).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"
                        Range(.Offset(5), .Offset(5).End(xlDown)).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"
                    End With
            End Select
        End If
    End If
Next ws

With Application
    .Calculation = xlAutomatic
    .ScreenUpdating = True
End With

End Sub
 
Upvote 0
John, thanks a ton! This is working great as faster. I just will take into consideration the use of End(xlDown) by inputting numbers to restrict it going down to till the millionth row.
 
Upvote 0
You're welcome!

I was looking at the screen captures again and just realised that I made one error in the code, I took Offset(5) from your original code, but with the selection removed, it should be Offset(7)
Also, if the number of rows to fill down never changes, then that can be specified in the code instead of using End(xlDown).
I've used the first section as an example here, but the same change could be applied to all sections, with just the formula changing each time. This will always enter 2 formulas 2 rows below the headings and 5 formulas 7 rows below the headings.

VBA Code:
            With vFound
                .Offset(2).Resize(2, 1).FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"
                .Offset(7).Resize(5, 1).FormulaR1C1 = "=IFERROR((RC[-2]/RC[-12])-1,0)"
            End With
 
Upvote 0
In addition to my reply above, looking at the screen capture in post 5, I think that dcolvar might not be looking where you think it is.

Should it be taking the last number entered in row 1? Because at the moment it's only looking to see which column has the last number in it, which will not give the same value.
Also, the pattern of results looks wrong, 2,4,7,10 and 3,5,8,11. Logic implies that it should be 1,4,7,10 and 2,5,8,11 respectively?
 
Upvote 0
the dcolvar looks at the last number of row 1. The accounting period is from Feb-Dec, skipping Jan month.
 
Upvote 0

Forum statistics

Threads
1,224,818
Messages
6,181,151
Members
453,021
Latest member
Justyna P

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