Macro worked, now it displays Run-time error 91

[msquared99]

This is just crazy, this macro has been running for a while and now it does not. For whatever reason now wbIC and wsIC shows "Nothing".

The error occurs on this line of code:

With wsIC 'sort asc in Col D
  .Cells(1).Sort Key1:=.Range("D2"), order1:=xlAscending, Header:=xlYes
  End With

To me it seems like the macro never opens the workbook.

Sub IC_Commissions()
 
  Dim wb As Workbook, wbIC As Workbook, wsIC As Worksheet, wsCS As Worksheet, wsM3 As Worksheet, wsIC2 As Worksheet
  Dim myPath As String, myFile As String, myExtension As String, RepName As String
  Dim ColHeads As Variant, RowHeads As Variant
  Dim calc As Long, LastRow1 As Long
  Dim mBefore As Date
  Dim d As String
  Dim colNum As Long
  Dim startRow As Long, endRow As Long, lastRow As Long
 
 
  'Optimize Macro Speed
  With Application
  .DisplayAlerts = False
  .ScreenUpdating = False
  .EnableEvents = False
  .AskToUpdateLinks = False
  calc = .Calculation
  .Calculation = xlCalculationManual
  End With
 
  With Application.FileDialog(msoFileDialogFolderPicker) 'Retrieve Target Folder Path From User, example Ash 03-15.xlsx
  .Title = "Select A Target Folder"
  .AllowMultiSelect = False
  If .Show <> -1 Then 'In Case of Cancel
  MsgBox "Please select target folder. Quitting..."
  GoTo ResetSettings
  End If
  myPath = .SelectedItems(1) & "\"
  End With
 
  'Open IC workbook if not already open and sort data in sheet Commissions
  On Error Resume Next
  Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
  If wbIC Is Nothing Then 'it is not open
  Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
  End If
  Set wsIC = wbIC.Worksheets("Commissions")
  With wsIC 'sort asc in Col D
  .Cells(1).Sort Key1:=.Range("D2"), order1:=xlAscending, Header:=xlYes
  End With
 
  With wsIC
  .Cells.Copy
  .Cells.PasteSpecial xlPasteValues
  .Cells(1).Select
  End With
 
  On Error GoTo 0
 
  mBefore = DateAdd("m", -1, Now)
  d = Format(mBefore, "mmmm")
  'Gets the name of last month.
 
  ColHeads = Array("Client Name", "Service", "Start Date", "Rep", "First Year Comm %", "Residual Commission", d & " IC Revenue", d & " Commission")
  'The column headers should be an exact match to the column headers in the IC workbook.
 
  myExtension = "*.xlsx" 'Target File Extension (must include wildcard "*")
  myFile = Dir(myPath & myExtension) 'Target Path with Ending Extention
 
  Do While myFile <> "" 'Loop through each Excel file in folder
  Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Set variable equal to opened workbook
  wb.Worksheets.Add(After:=Worksheets(1)).Name = "IC" 'With opened workbook add a sheet and rename
  With Worksheets("IC")
  .Range("A1:H1").Value = ColHeads
  .Range("A1:H1").Font.Bold = True
  .Columns("A:H").AutoFit
  End With
 
  RepName = Left(myFile, InStr(myFile, " ") - 1) 'extracts the Rep Name from the file name. -1 for removing space
 
  Set wsCS = Worksheets("Commission Summary") 'This is the worksheet in the Sales Rep workbook.
  Set wsM3 = Worksheets("M3") 'This is the worksheet in the Sales Rep workbook.
 
 
  With wsIC 'This is the worksheet in the Intercompany Billing workbook.
  .Cells(1).AutoFilter Field:=4, Criteria1:="=" & RepName
  With .AutoFilter.Range
  If .Columns(1).SpecialCells(xlCellTypeVisible).Count - 1 > 0 Then 'there is at least 1 row which meets the filter criteria
  For i = LBound(ColHeads) To UBound(ColHeads) 'Works through data on IC workbook and matches to existing workbook
  colNum = .Rows(1).Find(ColHeads(i)).Column
  .Columns(colNum).Offset(1).Resize(.Rows.Count - 1).Copy Destination:=wb.Worksheets("IC").Cells(2, i + 1)
  'offset 1 row to exclude the header row. +1 for first value of i = 0 ColHeads is zero based array
  Next i
  Else 'If no match is found then close the workbook.
  With wsM3
  lastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
  End With
  With wb.Worksheets("IC")
  .Delete
  End With
  wsCS.Range("B2") = "=sum(M3!P" & lastRow & ")"
  With wsCS
  .Columns("A:B").AutoFit
  End With
  lastRow = Empty
  wb.Close SaveChanges:=True 'False
  GoTo Nextfile
  End If
  End With
  End With
 
  With wb.Worksheets("IC")
  startRow = 2
  endRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
 
  Cells(endRow, 1).Value = "Total"
  Cells(endRow, 8).FormulaR1C1 = "=Sum(R[" & startRow - endRow & "]C:R[-1]C)"
  End With
 
  'Set wsCS = Worksheets("Commission Summary")
  'Set wsM3 = Worksheets("M3")
 
  With wb.Worksheets("IC")
  LastRow1 = .Cells(.Cells.Rows.Count, "H").End(xlUp).Row
  End With

  wsCS.Range("B3") = "=Sum(IC!H" & LastRow1 & ")"
  'add total of column H of IC worksheet to Commission Summary worksheet.
 
  With wsM3
  lastRow = .Cells(.Rows.Count, "P").End(xlUp).Row
  End With

  wsCS.Range("B2") = "=sum(M3!P" & lastRow & ")"
 
  With wsCS
  .Columns("A:B").AutoFit
  End With
 
  LastRow1 = Empty
  lastRow = Empty
  'Add total of column P of M3 worksheet to Commission Summary worksheet
  Worksheets("M3").Select
  Range("E6:E20000").Select
  Selection.NumberFormat = "mm/dd/yy;@"
  Range("H6:I20000").Select
  Selection.NumberFormat = "mm/dd/yy;@"
  Range("B6:B20000").Select
  Selection.NumberFormat = "0"
 
 
  wb.Close SaveChanges:=True
Nextfile:
  myFile = Dir 'Get next file name
  Loop
 
  wbIC.Close False 'close Intercompany Billing workbook without saving
 
ResetSettings: 'Reset Macro Optimization Settings
  With Application
  .EnableEvents = True
  .Calculation = calc
  .AskToUpdateLinks = True
  End With
 
End Sub

 

[Chihiro]

If the code has been working for while. I'd suspect issue to be elsewhere.

Likely file name was altered and not being opened as this portion is hard coded.

On Error Resume Next
  Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
  If wbIC Is Nothing Then 'it is not open
Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
  End If
  Set wsIC = wbIC.Worksheets("Commissions")

 

[msquared99]

I looked at that, I went back and re-typed the file name and I get the same error. I also checked the spelling and that was fine. I even went back and re-named the file in the folder. I also checked the name of the folder.

Finally, I just saved the file as another name, re-mapped it in the macro and now it works!

This is just crazy! How can that even be possible?

 

[Luke M]

The section in question doesn't properly open the file. You can't use wildcards like that. I think overall you missed the error because of the 'On error resume next'

'===CHANGE FROM THIS=====
'Open IC workbook if not already open and sort data in sheet Commissions
On Error Resume Next
Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
If wbIC Is Nothing Then 'it is not open
    Set wbIC = Workbooks("C:\Test\2015 Intercompany Billing.xls*")
End If
Set wsIC = wbIC.Worksheets("Commissions")
With wsIC 'sort asc in Col D
    .Cells(1).Sort Key1:=.Range("D2"), order1:=xlAscending, Header:=xlYes
End With

With wsIC
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
    .Cells(1).Select
End With

On Error GoTo 0
'===========

'===TO THIS LAYOUT====
'Open IC workbook if not already open and sort data in sheet Commissions
On Error Resume Next
Set wbIC = Workbooks("2015 Intercompany Billing.xlsx")
'Turn errors back on to see if you make a mistake
On Error GoTo 0

If wbIC Is Nothing Then 'it is not open
    Set wbIC = Workbooks.Open("C:\Test\2015 Intercompany Billing.xlsx")
End If
Set wsIC = wbIC.Worksheets("Commissions")
With wsIC 'sort asc in Col D
    .Cells(1).Sort Key1:=.Range("D2"), order1:=xlAscending, Header:=xlYes
    .Cells.Copy
    .Cells.PasteSpecial xlPasteValues
    .Cells(1).Select
End With
'===END CHANGES====