VBA Simplification

Hello all,

i have a macro code pasted below[it's working fine], this report contains full of excel formula's and connected the same file with the other sheets. And each and every sheet contains more than 1000 rows and 50 column full of formatted and formula's. it contains more than 40 sheets when i run this code it's taking too much time to produce the each "Call" wise report. so my request is this any other way to simplify this code would be fine. first it will start with Find_data().

Sub WithPivot()
Dim fname As String
Application.Calculation = xlManual
fname = ActiveWorkbook.Sheets("Input").Cells(2, 19).Value
     Application.ScreenUpdating = False
          Application.DisplayAlerts = False
     
     For i = ThisWorkbook.Worksheets.Count To 2 Step -1
  If Application.Worksheets(i).Name = fname Or Application.Worksheets(i).Name = "Report" Then
    Else
Application.Worksheets(i).Visible = xlSheetVeryHidden

Worksheets("Data").Visible = xlSheetHidden
    End If

Next i
ActiveWorkbook.Close True
End Sub
---------------------------------------------------------------------------------
Sub WithOPivot()

Dim fname As String
Application.Calculation = xlManual

fname = ActiveWorkbook.Sheets("Input").Cells(2, 19).Value
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
     
     For i = ThisWorkbook.Worksheets.Count To 2 Step -1
  If Application.Worksheets(i).Name = fname Or Application.Worksheets(i).Name = "Input" Or Application.Worksheets(i).Name = "Pivotl" Then
     Else
Application.Worksheets(i).Visible = xlSheetVeryHidden
Worksheets("Commit").Visible = xlSheetHidden
    End If
Next i

ActiveWorkbook.Close True

End Sub
   
----------------------------------------------------------------------------------   
       
Sub Find_data()
     
Dim Wrk As Workbook
Dim Wrs As Worksheet
Dim Wrk1 As Workbook

Set Wrk = ThisWorkbook
Dim relativePath As String

Dim fname As String

Application.DisplayAlerts = False

Lrow = Cells(Rows.Count, 13).End(xlUp).Row


For i = 1 To Lrow

A = 0
fname = ThisWorkbook.Sheets("Input").Range("M" & i).Value

relativePath = ThisWorkbook.Path & "\" & fname & ".xlsb"
Wrk.SaveCopyAs Filename:=relativePath

Set Wrk1 = Workbooks.Open(ThisWorkbook.Path & "\" & fname & ".xlsb")

ActiveSheet.Select
Dim rng As Range

If Trim(fname) <> "" Then
    With Sheets("Commitments").Range("C:C") 'searches all of column A
        Set rng = .Find(What:=fname, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not rng Is Nothing Then
            GoTo rng
        Else
            A = 1
            GoTo rng1 'MsgBox "Nothing found" 'value not found
        End If
    End With
End If

rng:

ActiveWorkbook.Sheets("Commitments").Select
    Rows("2:2").Select
    Range("C2").Activate
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$AT$100").AutoFilter Field:=3, Criteria1:="<>" & fname, Operator:=xlAnd

    Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("3:39").Select
    Range("C3").Activate
    Selection.Delete Shift:=xlUp
    Range("C2").Select
    ActiveSheet.ShowAllData
    Range("C2").Select

    ActiveWorkbook.Sheets("PO Pivot").Select
    Call AdjustPivotDataRange
    
    Call WithPivot
   
rng1:
If A = 1 Then

   Call WithOPivot
   
End If

  Next i
   
   
   MsgBox "Report generate is done"
   ActiveWorkbook.Close True
   
End Sub
--------------------------------------------------------------------------------------------
Sub AdjustPivotDataRange()

Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String

'Set Variables Equal to Data Sheet and Pivot Sheet
  Set Data_sht = ThisWorkbook.Worksheets("Commitments")
  Set Pivot_sht = ThisWorkbook.Worksheets("PO Pivot")

'Enter in Pivot Table Name
  PivotName = "PivotTable5"

'Dynamically Retrieve Range Address of Data
  Set StartPoint = Data_sht.Range("A2")
  Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
  
  NewRange = Data_sht.Name & "!" & _
    DataRange.Address(ReferenceStyle:=xlR1C1)

'Make sure every column in data set has a heading and is not blank (error prevention)
  If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
    MsgBox "One of your data columns has a blank heading." & vbNewLine _
      & "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
    Exit Sub
  End If

'Change Pivot Table Data Source Range Address
  Pivot_sht.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)
      
'Ensure Pivot Table is Refreshed
  Pivot_sht.PivotTables(PivotName).RefreshTable
  ActiveWorkbook.Worksheets("PO Pivot").Select
  
      Range("B8").Select
    ActiveSheet.PivotTables("PivotTable5").PivotCache.Refresh
    
End Sub

Thanks\Raj

I don't see anything in your code that would slow it down, other than the fact that you are loop 40 sheets. but this by you:

it's taking too much time to produce the each "Call" wise report

I did not follow because there is nothing in your code that says anything about a ""call wise"" report.

fine Norie, let me check Thank you....