Free Microsoft Excel 2013 Quick Reference

Runtime error 1004 Cannot Access file name

Hello all

I have a very simple line I have pulled out of a macro that is run from a button that is driving me crazy!!

It works fine on the first pass, but errors on the second click. I am in Excel 2007 on Vista

Below is the line

I know the workbook already exsists from the first running, but I still want to save and overwrite.

I don't care if I am asked if it is ok, or even if I am not. I just need to be able to run mare than once

ActiveWorkbook.SaveAs FileName:="[URL="file://PKAFS00/1pka"]PKAFS00/1pka[/URL] Quotes/Exported_Quotes/" & _SaveName & ".xlsm" 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Any help would be GREATLY appreciated!

I have updated so I can show the whole macro below

 Sub SaveWithVariableFromCell()

Dim SaveName As String
'Saves the workbook with the name created from combining the Customer, Quote number, version number and project name
ThisWorkbook.BuiltinDocumentProperties("Content Type") = ActiveSheet.Range("C8").Value
ThisWorkbook.BuiltinDocumentProperties("Keywords") = ActiveSheet.Range("E6").Value
ThisWorkbook.BuiltinDocumentProperties("Author") = ActiveSheet.Range("L10").Value
ThisWorkbook.BuiltinDocumentProperties("Subject") = ActiveSheet.Range("F2").Value
ThisWorkbook.BuiltinDocumentProperties("Title") = ActiveSheet.Range("E9").Value
SaveName = ActiveSheet.Range("I9").Value
ActiveWorkbook.SaveAs FileName:="PKAFS00/1pka Quotes/Exported_Quotes/" & _
SaveName & ".xlsm"

Post your answer or comment

comments powered by Disqus
I'm getting an error stating that there is a "Runtime error '1004': cannot access '***.csv'. The window that this error is displaying in has the buttons "End" "Debug" and "Help". This is the code:

Public Flag As Boolean

Sub ReRun()
nextRun = Now + TimeValue("00:00:03")
Application.OnTime nextRun, "ReRun"
Call saveworkbook
End Sub
Sub StartMacro()
'Run this macro to start "YourMacro"
Flag = False
Call ReRun
End Sub
Sub Auto_Close()
'Turns off the OnTime event when closing the file
Call StopMacro
End Sub
Sub StopMacro()
'Run this to turn off the OnTime event
On Error Resume Next
Application.OnTime nextRun, "ReRun", schedule:=False
End Sub
Sub saveworkbook()
If Flag = False Then
    Flag = True
    ActiveWorkbook.SaveAs Filename:="c:folderfilename.csv", FileFormat:=xlCSV
End If
End Sub
When the "Debug" button is clicked the error points to ActiveWorkbook.Save
The user then has to shut down the macro and then rerun it. Is there any way to have it catch the error and retry?

I am working on a project that involves the following steps:

1. Open Workbook1.
2. Capture Oracle data into a Sheet ("Data") in a new workbook, Workbook2. I use ADO. This is working.
3. Match the new sheet, "Data", with an existing sheet in Workbook1 ("Categories") and output the merged data into a new sheet in Workbook2. I use JET to accomplish reading Sheet ("Data"). I come up with error 1004 'cannot access file ..../xls'.

I started out just using 1 workbook, but then it always tried opening another instance of Workbook1 when it encountered the Jet connection Open command. Any ideas how I would best accomplish merging data from 2 different connections.

When i click on my req. to go to new requisition it gives me a run-time error 1004 cannot access read only document A70001.xls how do i fix this?


First dialog box show that : Excel cannot access "file name". The document
may be read-only or encrypted.
Then second dialog box show up : Cannot access "file name".

Any idea to solve this problem?

Thank you.

Gary DK very kindly provided a solution for naming tabs from the contents of
a cell on a worksheet. A further problem has arisen:

The contents of cell B7 on all 125 sheets provides the name for the sheet
tab. Cell B7 gets its information from a separate master sheet.

When I sort the master sheet (because new entries have been added at the
bottom and need to be arranged according to a ref. code) I get an error
message: Runtime error 1004 Cannot rename a sheet to the same name as another
sheet, a referenced object library or a workbook referenced by Visual Basic.

this is the code:

Option Explicit
Private shname As String

Private Sub Worksheet_Calculate()
If Range("B7").Value <> shname Then
shname = [b7].Value
End If
Me.Name = shname
End Sub

Any ideas?

Why do I get the error: "Runtime error 1004: Cannot rename a sheet to the same name as another sheet, a reference object library, or a workbook referenced by Visual Basic"?

And how do I fix it? I have a macros that someone else made (thank you) and I need to make the macros create anywhere from 5-125 sheets based on the information added in sheet 1. How can I do this whe it stops me after 5 or so with the error above.


I just got a new machine installed and I get the following messade when I try
and open some reports done in Excell: "Runtime error: 1004. Programmatic
access to Visual Basic Project is not trusted. How can I fix this?

I'm running some code on XP Excel 2007 and receive the error below

Runtime error '1004'
Programmatic access to Visual Basic Project is not trusted.

I found a solution to this issue - used it and it DOES solve the issue - no more error and my program executes correctly on the XP Excel 2007 system where it previously failed
(NOTE: This same code works correctly on my XP Excel 2000 system)
From the MS KB Article #812969

When you run code that uses the Microsoft Visual Basic for Applications Extensibility 5.3

Library, you may receive the following error message:

Run-time error '1004': Programmatic access to the Visual Basic Project is not trusted

Excel 2007
Click the Microsoft Office Button, and then click Excel Options.
Click Trust Center.
Click Trust Center Settings.
Click Macro Settings.
Click to select the Trust access to the VBA project object model check box.
Click OK to close the Excel Options dialog box.

Excel 2003
On the Tools menu, point to Macro, and then click Security.
In the Security dialog box, click the Trusted Sources tab.
Select the Trust access to Visual Basic Project check box.
Click OK.

Is there a way for me to turn this setting ON programatically when I need it?


BTW: A better solution would be - get the setting that the user has, set it to what I need to not CRASH, then return back to the USERS setting after I'm done.

A few weeks ago I found some code from this discussion group that allowed me
to delete all of the code modules from a workbook:

Set VBComps = NewBook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case vbext_ct_StdModule, vbext_ct_MSForm, _
VBComps.Remove VBComp
Case Else
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next VBComp

It worked like a charm. Yesterday I got a new computer at work running XP
and Excel 2003. Now I'm getting this error message:
runtime error '1004' Programmatic access to Visual Basic Project is not

I have my security settings on low. Any ideas of how I can make this work

I have quite an interesting problem. I have an XLSM spreadsheet with an Auto_Open macro that imports data from a CSV file and does some deletion/formatting. It then saves that sheet back over the existing CSV file. I then want to resave the workbook over the existing XLSM file. If Excel 2007 is closed before the macro runs, I get "Runtime error '1004': Cannot access 'Computer Name Listing.xlsm'". However, if I run the Auto_Open macro with the workbook already open, the problem does not happen. Any ideas? The problematic section of my code is below.

    Application.DisplayAlerts = False
    Dim oldName As String, oldPath As String, oldFormat As XlFileFormat
    With ActiveWorkbook
        oldName = .Name
        oldPath = .Path
        oldFormat = .FileFormat
        .ActiveSheet.SaveAs Filename:="bla blaNames.csv", FileFormat:=xlCSVWindows
        .SaveAs Filename:=oldPath + "" + oldName, FileFormat:=oldFormat
    End With
    Application.DisplayAlerts = True
If I enter debugging mode, the error line is the ".SaveAs Filename..." line.

Thanks for your help.

I don't know what went wrong but this same piece of macro code was running yesterday and today it is giving me this error. can a pro take a look. please..
Sub pinfo()
Dim pages As Integer
Dim x As Integer
x = 1
For pages = 1 To 30
    With ActiveSheet.QueryTables.Add(Connection:= _
& pages _
        , Destination:=Range("$A$1"))
        .Name = _
& pages
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Do Until Cells(x, 1) = vbNullString
        x = x + 1
    Cells(x, 1).Select
    Application.CutCopyMode = False
Next pages
End Sub
the error i get is
Runtime Error '1004'
File could not be accessed. try one of the following
- make sure the specified folder exists
- make sure the folder that contains the file is not read-only
- make sure the filename does not contain any of the characters < > ?  [ ] | 
- make sure file/path name does not contain more than 128
any insights into how to solve this will be greatly appreciated

I've got some code that used to work and now has suddenly stopped working and I cannot see the reason why. It generates a Runtime error 1004 Application-defined or object-defined error. The line of code between the the two lines of ######## is the one highlighted when I debug. (Sorry tried highlighting line in red but couldn't get it to work!)

Anyone got any ideas?



     'Import products button clicked
    Dim wkbsource As Workbook 
    Dim wkbtarget As Workbook 
    Dim lfilename As String 
    Dim try As Double 
    Dim response As Double 
    Dim norows As Double 
    Dim n As Double 
    Dim productsku As Variant 
    Dim producttargetrow As Double 
    Dim norows2 As Double 
    Dim percentdone As Double 
    Dim newproducts As Double 
    Dim updatedproducts As Double 
     'first check user security level
    If Sheet23.enablesecurity.Value = True And Sheet23.allowproductaddedit = False Then 
        If currentsecuritylevel < 2 Then Call getsecuritypassword(2) 
        If currentsecuritylevel < 2 Then Exit Sub 
        oldsecuritylevel = currentsecuritylevel 'NOTE: this will only be a permanent log in
        Call updatestatusbar 
    End If 
    Call MsgBox("Import products data from an excel worksheet:" & vbCrLf & "" & vbCrLf & "Column A: Item Code (SKU)" & vbCrLf
& "Column B: Product Description" & vbCrLf & "Column C: Product Gross Price (inc. VAT)" & vbCrLf & "Column D: Tax Class" &
vbCrLf & "Column E: Deal Code (You may leave this column blank)" & vbCrLf & "Column F: " & Sheet18.Range("F25") & " (You may
leave this column blank)" & vbCrLf & "Column G: " & Sheet18.Range("F26") & " (You may leave this column blank)" & vbCrLf &
vbCrLf & "If the item code already exists the product details will be updated." & vbCrLf & "" & vbCrLf & "NOTE: We assume
that the first row contains column headings and not product details." & vbCrLf & "" & vbCrLf & "Please choose a file to
import.", vbInformation Or vbDefaultButton1, "Import products") 
    lfilename = Application.GetOpenFilename(fileFilter:="Excel Workbook (*.xlsx;*.xls), *.xlsx;*.xls") 
     'Did they cancel choosing a import file name? If so exit subroutine doing nothing
    If lfilename = "False" Then Exit Sub 
     'speed up code
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 
    Call checkproductfileexists 
     'First we test the data to check that each row has data in Columns A-D
    Set wkbsource = Workbooks.Open(lfilename) 
     'find number of rows in source worksheet
    norows = wkbsource.Sheets(1).Range("A" & LTrim(Str(maxrows))).End(xlUp).Row 
    If norows < 2 Then 
         'There is no data to import
        Call MsgBox("IMPORT CANCELLED: No products to import. Please check your data.", vbDefaultButton1 Or vbExclamation,
        Exit Sub 
    End If 
    For n = 2 To norows 'we start from row 2 as we assume that row 1 is column headings
        If n Mod 400 = 0 Then 
            percentdone = Round((n / norows) * 100, 2) 
            Application.ScreenUpdating = True 
            Sheet12.Cells(27, 9) = "Please Wait Testing Data..." & Str(percentdone) & "% done" 
            Application.ScreenUpdating = False 
        End If 
        If wkbsource.Sheets(1).Cells(n, 1) = vbNullString Or wkbsource.Sheets(1).Cells(n, 2) = vbNullString Or
wkbsource.Sheets(1).Cells(n, 3) = vbNullString Or wkbsource.Sheets(1).Cells(n, 4) = vbNullString Then 
             'There is missing data in columns A-D
            Call MsgBox("IMPORT CANCELLED: Error on row " & Str(n) & "! There is missing data in columns A to D in the data
you want to import. Please check your data.", vbDefaultButton1 Or vbExclamation, "") 
            Sheet12.Cells(27, 9) = vbNullString 
            Exit Sub 
        End If 
        If Not IsNumeric(wkbsource.Sheets(1).Cells(n, 3)) Then 
             'The price column holds data that is not a number
            Call MsgBox("IMPORT CANCELLED: Error on row " & Str(n) & "! Column C must only contain numbers. Please check your
data.", vbDefaultButton1 Or vbExclamation, "") 
            Sheet12.Cells(27, 9) = vbNullString 
            Exit Sub 
        End If 
        If wkbsource.Sheets(1).Cells(n, 1) = 0 And IsNumeric(wkbsource.Sheets(1).Cells(n, 1)) Then 
             'The item code of zero
            Call MsgBox("IMPORT CANCELLED: Error on row " & Str(n) & "! Item code cannot be '0' (zero). Please check your
data.", vbDefaultButton1 Or vbExclamation, "") 
            Sheet12.Cells(27, 9) = vbNullString 
            Exit Sub 
        End If 
    Next n 
     'Now import the products to the product data file
     'we open the file that contains the data to import and copy this to the productdata file
    Dim test As Boolean 
    try = 0 'we try a few times to open the product data file, if we can't because other people are accessing it we will give
    try = try + 1 
     'now we open the product list file and check we can write to it
    Application.ScreenUpdating = False 
    test = IsFileOpen(Sheet11.Cells(18, 4) + "systemdataproductdata.xlsx") 
    If test And try > maxtry Then 
        response = MsgBox("Error! Unable to open product data file for importing stock changes to. It is probably in use by
another user. Would like to try again?", vbRetryCancel Or vbCritical Or vbDefaultButton1, "Error!") 
        If response = vbRetry Then 
            Goto beginagain3 
            Exit Sub 
        End If 
    ElseIf test And try

Hi - I'm trying to trap the runtime error 1004. However, I have discovered that there are lots of different variations - these are just a few that I found this morning in my search for an answer to my question:-
- Application-defined or operation-defined error.
- Select method of range class failed.
- Unable to get the CheckBoxes property of the Workhseet class
- Method "Range' of object_Global' failed
- Copy Method of Worksheet Class failed
- Application-defined or object-defined error
- Programmatic access to the Visual Basic Project is not trusted
- Calculate method of Range class failed
- Unable to set the LineStyle property of the Border class
- Show method of Dialog class failed

I need to trap a specific variation of this error, namely:-
- Microsoft Excel cannot access the file 'bla-bla-bla'. There are several possible reasons:
• The file name or path name does not exist.
• The file you're trying to open is being used by another program. Close the document in the other program, and try again.
• The name of the workbook you're trying to save is the same as the name of another document that is read-only. Try saving the workbook with a different name.

Therefore, I need to trap an error not using Err.Number, but Err.Description. In trying to do so, I obviously cannot refer to the whole error, as this will be different each time - depending on the filename.

I've put some ErrorTrappingCode together, which is obviously not working - just wondering if anyone has any ideas that might solve this little problem for me?

ErrorTrappingCode :
    Select Case Err.Number
        Case 1004:
            Select Case Err.Description
                Case "Microsoft Excel cannot access the file":
                MsgBox "You do not have access to this drive. Please request access before trying again."
                Case Else
                MsgBox "Error 1004" 'for testing purposes only
                Call SEND_ERROR_EMAIL
            End Select
        Case Else:    'An error other than 1004 has occurred.
        Msg = "The following error has been sent." & vbCrLf
        ErrMsg = "Error number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description
        MsgBox Msg & vbCrLf & ErrMsg, vbCritical, "ERROR MESSAGE"
    End Select

Using Excel 2003, an application asks the user for a .txt file to open using
the open dialog. After the file has been opened, the code changes the name of
the sheet using Sheets(1).Name = "Data".

This works fine most of the tiime but with some file names, it causes
Runtime Error 1004. An example of a name that causes the error is
"report_PO_11-3-2005_11_3_2005[1].txt". If I rename the file and take out the
brackets, it works OK.

Is there some way I can avoid this error so that the user doesn't have to
rename the file every time? These files are downloaded from a web site so I
don't have anty control over the names.

Using Excel 2003, an application asks the user for a .txt file to open using
the open dialog. After the file has been opened, the code changes the name of
the sheet using Sheets(1).Name = "Data".

This works fine most of the tiime but with some file names, it causes
Runtime Error 1004. An example of a name that causes the error is
"report_PO_11-3-2005_11_3_2005[1].txt". If I rename the file and take out the
brackets, it works OK.

Is there some way I can avoid this error so that the user doesn't have to
rename the file every time? These files are downloaded from a web site so I
don't have anty control over the names.

I had a piece of code working when I edited the last version and ran it. However, once I closed the workbook and returned to it this morning, a strange thing happened. When I input the folder and subfolder names, i.e. defined the string sPath, the macro errors out saying that it can not find a particular file. The strange thing is that the file it is looking for is on my desktop, not in the defined sPath. Here's the code which originally worked:

Option Explicit 
Sub Monthly_Analyser() 
    Dim Ci As Long 
    Dim wbResults As Workbook 
    Dim MyWorkbook As Workbook 
    Dim strYear As String 
    Dim strMonth As String 
    Dim sPath As String 
    Dim sFil As String 
    Application. ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
    strYear =  InputBox("Please Enter the Year", "Year Required for  Analysis") 
    strMonth = InputBox("Please Enter the Month", "Month Required for Analysis") 
    Set MyWorkbook =  ThisWorkbook 
    Ci = 2 
    sPath = "h:My DocumentsMacroTest" & strYear & "" & strMonth & "" 
    ChDir sPath 
    sFil = Dir("*.xls") 
    Do While sFil  "" 
        Set wbResults = Workbooks.Open(sPath & "" & sFil) 
        With wbResults 
            . Sheets("Day").Range("A4:B680").MergeCells = False 
            .Sheets("Day").Range("B4:B680").Copy MyWorkbook.ActiveSheet.Cells(4, Ci) 
        End With 
        wbResults.Close True 
        sFil = Dir 
        Ci = Ci + 1 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
End Sub
Any idea why the code is looking in a location outside of where it has been told to look? The code looks ok to me, as the path in which to look is predefined by user input as sPath and the directory within that path in which the file to be opened (sFil) is also predefined before the Workbooks.Open command is given:

strYear = InputBox("Please Enter the Year", "Year Required for Analysis") 
strMonth = InputBox("Please Enter the Month", "Month Required for Analysis") 
Set MyWorkbook = ThisWorkbook 
Ci = 2 
sPath = "h:My DocumentsMacroTest" & strYear & "" & strMonth & "" 
ChDir sPath 
sFil = Dir("*.xls") 
Do While sFil  "" 
    Set wbResults = Workbooks.Open(sPath & "" & sFil)
yet the code still trys to open a file which is saved on the desktop (incidentally, the file it is trying to locate is the first .xls file on my desktop). It's like the path is ignored and the code starts looking for all .xls files, starting at the highest tier, i.e. the desktop. Then it errors out saying that it cannot locate that file. Seems to me that it doesn't know where to look in the first instance, going straight to the desktop to look for all .xls files, but in checking, discovers that the file it thinks it needs to open, isn't in the specified directory. Strange.
Any thoughts on that?
PS - this is a copy of a request I put at the end of a thread which I have cross posted on Ozgrid. See here: , thread entitled "Convert 2003 Macro To 2007 - Application.Filesearch"

Thank you so much for your help so far. However, I have another
question. In my script I would like to save my workbooks to a mapped
drive. I filled in the blanks for the save code and tried it out. It
goes up to the third entry saves it and by the fourth I get a error
message. Runtime error 1004 - MS Office Excel cannot access the file
"blahblahblah" There are several possible reasons. It gives four
options but the contiue button is grayed out. Can you help?


Here is the sample code:

bk.SaveAs Filename:="syslea222busserveCredit LogsArcher
ProjectMaster Customer List" & Worksheets("PD").Range("F6").Value &
bk.Close SaveChanges:=False


I've just written the following VB script from code snippets I've found on this forum.

What it does (or rather should do) is to save a copy of the entire Workbook in the same directory as the original, but
call it ("what ever is written in cell A1") and append ".xls" to the end.

This should all be done without altering the data, or the filename of the original Workbook which the code is being triggered from.

     'This will save a copy of the workbook (.xls file)
     'and name it whatever is in Cell A1, but keep the
     'original workbook (.xls file) open and identical.
    Dim sPath As String 
    Dim ws As Worksheet 
    Set ws = ActiveSheet 
    sPath = ThisWorkbook.Path & "" 
    sPath = sPath & ws.Range("A1") & ".xls" 
    Call ThisWorkbook.SaveCopyAs(sPath) 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The control CommandButton1 is on the first of 8 Sheets in the Workbook.

This seems to work fine when the Sheets contain very little data, but fill all 8 Sheets with just 10 rows of data in 15
columns and I get a 'Runtime Error 1004' whenever I run the macro....

The error box that come up implies that the file (the one I want it saved as) could not be found??

Of course it can't be found, I want it created!!

Can anybody tell me why this might happen?

Maybe I need to disable something at the start, then enable it again at the end of my code?

I have attached 2 workbooks in a zip file:

A.xls - is empty and works.
B.xls - has 10 rows, 15 columns of data and causes an error.




I have an excel spreadsheet that uses a macro to open
another excel spreadsheet via Workbooks.Open(filename)

On my local drive this works fine and it opens the second
file, runs the query, and closes it without complaint.
When I run it via a network drive it works fine as well.

However, when I try to run it via a browser (i.e. put the
file on a web server and then open the url as") and then run the
macro I get a runtime error 1004 stating "Method 'Open' of
object 'Workbooks' failed".

Any idea what is causing this?

To complicate matters more, when it gives me the error it
gives me the option of "End" or "Debug". If I click Debug
it brings up the code window. If I then click Run without
making any changes it runs properly.



Ken Hunter


i receive an error message whenever i try to step through the
following code. i don't know why excel cannot find the ?
if anyone has an suggestions as to why, it would be greatly

thanks in advance - jung

i only posted a couple of lines below to get the just of the problem.
Dim lastrow As Integer

If Workbooks.Count 2 Then
MsgBox "FUNCTION CANCELLED! " + Chr$(13) + Chr$(13) & "The
Macro workbook and the workbook to be formatted should be the only
workbooks open.", vbCritical
Exit Sub
End If

lastrow = Range("A65536").End(xlUp).Row ' determine last row
of data
ActiveWindow.Zoom = 85
Cells.Font.Name = "Arial"
Cells.Select 'recevie runtime error 1004

ActiveCell.FormulaR1C1 = "INTERNAL #"
ActiveCell.FormulaR1C1 = "OBLIGOR #"

I am trying to copy a whole sheet from a workbook into another. My current code is presented below. When I run this I get 'Runtime error '1004'. The copy method in the Worksheet class failed.' Any ideas or suggestions?

        Dim basebook As Workbook
    Dim oubook As Workbook
    Set basebook = ThisWorkbook
    Set oubook = Workbooks.Open(Application.GetOpenFilename("Excel file,*.xls", , "Open Occasional Use log
    oubook.Worksheets(1).Copy after:= _
    ActiveSheet.Name = oubook.Name

I have a workbookwith 84 sheets. When I try to select (or activate) a range I
get runtime error 1004. In debugging the file, I find I can print the
individual cells (in a different workbook, wkFix), but cannot select the
range. Here's the relevant code:

With wkState.Sheets("NDX1")
For j = iCol1 To iCol2
wkFix.Sheets(1).Cells(j - iCol1 + 1, 13) = .Cells(jRow, j)
Next j

' I have no problem in printing

Range(.Cells(jRow, iCol1), .Cells(jRow, iCol2)).Select

'But the above line gives me the runtime error

End With

Can this have anything to do with the number of spreadsheets?

I'm running VBA 6.3, Excel 2003 SP1 with XP Pro


I have a report that I run on a weekly basis and have not had an issue with it until it started pulling in August data. It's a set of three pivot tables that pull data in from an Access database. Attached is a snapshot of the report with the three tabs... the first tab runs fine but when I try to run the second and third I get the following error message:

"run-time error 1004: Cannot change this part of a PivotTable report"

When I go in to debug the error it brings me to the following line in the code:

'add YTD header
Cells(lProw + 1, iLcol + 1).Value = "YTD"

I have a feeling that since we're now in August and theres three columns per month we're going over the 26 columns, as referenced at the bottom of the code. But I'm not sure where to go from there.

Here's the code
Sub AddYTDColumns()
Dim iCol As Integer
Dim iEcol As Integer 'last column for month
Dim iFcol As Integer 'first month column
Dim iLcol As Integer 'last column
Dim iSums As Integer
Dim lDrow As Long 'first data row
Dim lLrow As Long 'last row of ptable
Dim lProw As Long '1st ptable row
Dim lRow As Long
Dim sAcell As String 'activecell address
Dim pt As PivotTables
Dim wS As Worksheet
Dim vSums() As Variant

Set wS = Sheets(ActiveSheet.Name)
Set pt = wS.PivotTables
'exit if no pivot tables on active sheet
If pt.Count = 0 Then Exit Sub

'store activecell to be reselected at end
sAcell = ActiveCell.Address

'first row of pivot table
lProw = pt.Item(1).TableRange1.Row
'first row of data (hours) area
lDrow = pt.Item(1).DataBodyRange.Row

'get pivot table address
i = pt.Item(1).TableRange1.Address
'find last $
j = InStrRev(i, "$")
'last row of pivot table
lLrow = Mid(i, j + 1)
'last column of pivot table
k = InStr(i, ":$")
l = Mid(i, k + 2, Len(j - k + 2))
iLcol = Columns(l).Column

'clear current YTD columns
ClearYTD lProw, lLrow, iLcol

'find first month (data area)
iFcol = pt.Item(1).DataBodyRange.Column
'row w/ hourtypes
lRow = lProw + 2

x = Cells(lRow, iFcol)
For iEcol = iFcol + 1 To iLcol
Y = Cells(lRow, iEcol).Value
If Y = x Or Y = "" Then
iEcol = iEcol - 1
Exit For
End If

'add YTD header
Cells(lProw + 1, iLcol + 1).Value = "YTD"
'copy & paste hourtype headers from first month
Range(Cells(lRow, iFcol), Cells(lRow, iEcol)).Copy
Cells(lRow, iLcol + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

'calc # of types, create array with sum formulas for each type
iSums = iEcol - iFcol

ReDim vSums(iSums)

For i = 0 To UBound(vSums)
vSums(i) = "=SUM("

'loop thru months, create a total sum for each type
For iEcol = iFcol To iLcol Step iSums + 1
For i = 0 To UBound(vSums)
'add type column to sum statement, for last month add ')', otherwise add a ','
vSums(i) = vSums(i) & ColLtr(iEcol + i) & lDrow & _
IIf(iEcol >= iLcol - iSums, ")", ",")

'add formulas from array to 1st row of YTD column, use autofill to copy formulas
' to other cells in columns
For iCol = iLcol + 1 To iLcol + iSums + 1
i = iCol - (iLcol + 1)
Cells(lDrow, iCol).Formula = vSums(i)
Cells(lDrow, iCol).Select
x = ColLtr(iCol)
Selection.AutoFill Destination:=Range(x & lDrow & ":" & x & lLrow)

'copy formats from first month to YTD columns
iEcol = iFcol + iSums
lRow = lProw + 1

Range(ColLtr(iFcol) & lRow & ":" & ColLtr(iEcol) & lLrow).Select
Cells(lRow, iLcol + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Range(ColLtr(iLcol + 1) & lRow & ":" & ColLtr(iLcol + iSums + 1) & lLrow).Select
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous

'store last row
lLPrevRow = lLrow

End Sub

Private Sub ClearYTD(lProw As Long, ByVal lLrow As Long, iLcol As Integer)
'clear YTD columns
Dim iCol As Integer
Dim iEcol As Integer
Dim lRow As Long

'determine last row
If lLPrevRow > lLrow Then lLrow = lLPrevRow

'find YTD columns
lRow = lProw + 1
For iCol = iLcol + 1 To 256
If Cells(lRow, iCol).Value = "YTD" Then
lRow = lRow + 1
'if YTD found then determine # of YTD columns to be cleared
For iEcol = iCol To 256
If Cells(lRow, iEcol).Value = "" Then
If iEcol > iLcol + 1 Then iEcol = iEcol - 1
Exit For
End If
If iEcol >= 256 Then iEcol = iCol + 1
Exit For
End If

If iCol >= 256 Then Exit Sub

'select YTD columns
Range(ColLtr(iLcol + 1) & lProw & ":" & ColLtr(iEcol) & lLrow).Select

'clear data
'clear formating
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = xlAutomatic
End With
End Sub

Private Sub NoBorders()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

'translate passed column# into it's letter equivalent, uses Chr function to change number
' to letter (Ascii A = 65, Z = 90 so add 64), for columns over 26 divide the number by
' 26, the first letter will be the quotient the second will be the remainder (mod)
Public Function ColLtr(ByVal iColNo As Integer) As String
Dim iMod As Integer
Dim sCol As String

If iColNo >= 1 And iColNo <= 26 Then
sCol = Chr(iColNo + 64)
iMod = iColNo Mod 26
If iMod = 0 Then iMod = 26
iColNo = iColNo - iMod
iColNo = iColNo / 26
sCol = Chr(iColNo + 64) + Chr(iMod + 64)
End If

ColLtr = sCol

End Function

Hello guys.

I have a simple macro that basically gives format to a txt file and pastes it into an xls file.... I have sent the macro to 34 users, and 18 run it well, but the others 16 don't. In those 16 appears the runtime error 1004: AutoFill method of Range class failed

     ' Mac1 Macro
    ChDir "C:ExportaDolares" 
    Workbooks.OpenText Filename:= _ 
    "C:ExportaDolaresForeignCurrencyTxns_315_20120629.txt", Origin:=xlMSDOS, _ 
    StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _ 
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _ 
    , Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1 _ 
    ), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _ 
    Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1)), _ 
    ChDir "C:USD" 
    Workbooks.Open Filename:="C:USDformato.xls", Origin:=xlWindows 
    ActiveSheet.Range("$A$1:$M$4680").AutoFilter Field:=1, Criteria1:="=", _ 
    Operator:=xlOr, Criteria2:="=CinemaOperator" 
    Range(Selection, Selection.End(xlDown)).Select 
    Selection.Delete Shift:=xlUp 
    Selection.Delete Shift:=xlToLeft 
    Selection.Insert Shift:=xlToRight 
    Selection.Insert Shift:=xlToRight 
    Selection.Insert Shift:=xlToRight 
    Selection.Delete Shift:=xlToLeft 
    ActiveWindow.LargeScroll ToRight:=-1 
    ActiveCell.FormulaR1C1 = "=DAY(RC[-5])" 
    ActiveCell.FormulaR1C1 = "=MONTH(RC[-6])" 
    ActiveCell.FormulaR1C1 = "=YEAR(RC[-7])" 
    Lastrow = ActiveSheet.UsedRange.Rows.Count 
    Range("G2").AutoFill Destination:=Range("G2:G" & Lastrow) 
    Range("G2:G" & Lastrow).Select 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
This is the wrongful line:

Range("G2").AutoFill Destination:=Range("G2:G" & Lastrow) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Again, I don't understand why this happens only with half the users.

Thanks in advance for your time.

No luck finding an answer? You could always try Google.