Run-time error '5': Invalid procedure call or argument; can't resolve

JimmyV

New Member
Joined
Nov 18, 2017
Messages
2
I am trying to get a set of Excel files that are unique by campaign type with pivot tables for geographic regions in separate worksheets to instead be pasted values for each campaign type in separate worksheets in unique geographic region Excel files. I first change the .xlsx files to instead be .xls files (not sure why I had to but my code wouldn't progress otherwise). This works ok, but when proceeding through the list of geographic regions (range in Zones files), if a non-match is found for one of the campaign types (i.e., campaign not run in that geography), then the code errors out on the fn = Dir line. To mitigate this error, I tried changing the method to instead create a filename to store each geography (as in https://www.experts-exchange.com/qu...g-Dir-Invalid-procedure-call-or-argument.html), but I ran into another problem). Any help would be appreciated. I guess I can always re-do my overall work design, but I thought this wouldn't be that tough. Now, I'm just frustrated and want the issue resolved. Please educate me - Thanks!


Sub CombineWorkbooks()

Dim range1 As Range
Dim cell As Range
Dim Filename, Pathname, Pathname2, saveFileName As String
Dim wk As Workbook
Dim wo As Workbook
Dim initialDisplayAlerts As Boolean
Dim fn As String
Dim WSName As String
Dim wb As Excel.Workbook
Dim WT As Object
Dim wb1 As Excel.Workbook
Dim wb2 As Excel.Workbook

Pathname = "C:\Users\jdoe\Desktop\Client”
Pathname2 = "C:\Users\jdoe\Desktop\Client\Revised\”
Filename = Dir(Pathname & "*.xlsx")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
'Need to convert to .xls for some reason for macro to work
Do While Filename <> ""
Set wk = Workbooks.Open(Filename:=Pathname & Filename, _
UpdateLinks:=False)
wk.CheckCompatibility = False
saveFileName = Replace(Filename, ".xlsx", ".xls")

wk.SaveAs Filename:=Pathname & saveFileName, _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

wk.Close SaveChanges:=False
If Right(Filename, 4) = "xlsx" Then Kill Pathname & Filename
Filename = Dir()
Loop

Application.DisplayAlerts = initialDisplayAlerts

Set wo = Workbooks.Open("Jdoe\Desktop\Client\Zones.xls")

Set range1 = wo.Sheets("Zones").Range("A1:A26")

For Each cell In range1

WSName = cell
On Error GoTo Nxt
Application.ScreenUpdating = False
Application.DisplayAlerts = False
fn = Dir(MyPathName & "\*.xls")

Do While fn <> ""
Set wb = Application.Workbooks.Open(MyPathName & "" & fn)
If MySheetExists(wb, WSName) Then
' Sheet name exists
Else
ActiveWorkbook.Close (False)
GoTo Nxt
End If
With Workbooks.Open(MyPathName & "" & fn)
With .Sheets(WSName)
.Name = Left(fn, Application.WorksheetFunction.Find("(", fn) - 2)
.Copy After:=ThisWorkbook.Sheets(1)
End With
.Close False
End With
Nxt:
fn = Dir
Loop

Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Add

For Each WT In wb1.Sheets
If WT.Name <> "Sheet1" Then
WT.Move After:=wb2.Sheets(wb2.Sheets.Count)
End If
Next WT

For Each WT In wb2.Sheets
WT.Cells.Copy
WT.Cells.PasteSpecial xlPasteValues
Next WT

Application.CutCopyMode = False

wb2.Sheets("Sheet1").Delete
wb2.SaveAs Filename:=Pathname2 & WSName & ".xls"

Next cell

End Sub
Public Function MySheetExists(wb As Excel.Workbook, WSName As String) As Boolean
Dim WS As Excel.Worksheet
On Error Resume Next
Application.DisplayAlerts = True
Set WS = wb.Worksheets(WSName)
MySheetExists = Not (WS Is Nothing)
End Function
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
[TABLE="width: 660"]
<tbody>[TR="class: comment js-comment"]
[TD="class: comment-text js-comment-text-and-form"]I ended up working with the RDB Merge Add-In and some different VBA to get what I needed done[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited by a moderator:
Upvote 0

Forum statistics

Threads
1,224,558
Messages
6,179,512
Members
452,919
Latest member
krismmmitch

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