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
 
VBA Code:
Range(.Offset(2), .Resize(2, 1).FormulaR1C1) = "=IFERROR((RC[-3]/RC[-4])-1,0)"
                Range(.Offset(7), .Resize(5, 1).FormulaR1C1) = "=IFERROR((RC[-3]/RC[-4])-1,0)"
These 2 lines have made this sheet 100% efficient.
The overall code has helped me out immensely. I was afraid of using (For Each) before as I'm not good with it, but it's helped me understand the thinking. Thanks a million again.
 
Upvote 0

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.
the dcolvar looks at the last number of row 1
If that is what it should be doing, then you need
VBA Code:
dcolvar = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Value
.Column looks at the column position, not the number in the cell.
 
Upvote 0
I got 1 issue that I just noticed. After it quickly calculates the numbers for year, month, and quarterly for 1 sheet, 43 other sheets only load the yearly column, but not the monthly and quarterly. This is the entire code that I've ( including inserting a column prior to the last month).

VBA Code:
Sub insert_column()

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
        
        dcol = Cells(2, Columns.Count).End(xlToLeft).Column
             
        Columns(dcol).Select
        
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        
        Columns(dcol + 1).Select
        Selection.Copy
        
        Columns(dcol).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    End If
    
    End With

    Next i
    
Exit Sub

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.StatusBar = True

End Sub



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
                .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
        End If
   
        Set vFound = Cells.Find("month", ActiveCell, xlValues, xlPart, xlByColumns, xlNext, False, False)

        If Not vFound Is Nothing Then
            With vFound
                .Offset(2).Resize(2, 1).FormulaR1C1 = "=IFERROR((RC[-3]/RC[-4])-1,0)"
                .Offset(7).Resize(5, 1).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("qtr", ActiveCell, xlValues, xlPart, xlByColumns, xlNext, False, False)
    
        If Not vFound Is Nothing Then
        
            Select Case dcolvar
                Case 2, 4, 7, 10
                    With vFound
                        .Offset(2).Resize(2, 1).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"
                        .Offset(7).Resize(5, 1).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-5])-1,0)"
                    End With
                Case 3, 5, 8, 11
                    With vFound
                        .Offset(2).Resize(2, 1).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"
                        .Offset(7).Resize(5, 1).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-6])-1,0)"
                    End With
                Case Else
                    With vFound
                        .Offset(2).Resize(2, 1).FormulaR1C1 = "=IFERROR((RC[-4]/RC[-7])-1,0)"
                        .Offset(7).Resize(5, 1).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
Check the lines that start with Set vFound = ws.Cells.Find( ws. is missing from some of them.

Also, see post 12.
 
Upvote 0
Check the lines that start with Set vFound = ws.Cells.Find( ws. is missing from some of them.

Also, see post 12.
Excuse my silliness. It now references it and has performed it. I've adjusted according to post#12 as well. Have a good weekend Sir!
 
Upvote 0

Forum statistics

Threads
1,224,822
Messages
6,181,165
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