2

I have a macro that needs to open a few excel files and copy data from those files and paste them into the macro file in a sheet named "Consolidated". The macro goes to a specified path, counts the number of files in the folder and then loops through to open a file, copy the contents and then save and close the file.

The macro runs perfectly on my system but not on the users systems.

The error i am receiving during the looping process is "Runtime Error '9' Subscript out of range". The line on which this error pops up is

 Set wb = Workbooks.Open(Filename:=.FoundFiles(file_count)) 

At first i thought that the files might be opening slower than the code execution so i added wait time of 5 seconds before and after the above line...but to no avail.

The code is listed below

 Sub grab_data() Application.ScreenUpdating = False Dim rng As Range srow = ThisWorkbook.Sheets("Consolidated Data").Cells(65536, 11).End(xlUp).Row 'Number of filled rows in column A of control Sheet ThisWorkbook.Sheets("Control Sheet").Activate rawfilepth = Sheets("Control Sheet").Cells(65536, 1).End(xlUp).Row 'Loop to find the number of excel files in the path in each row of the Control Sheet For folder_count = 2 To rawfilepth wkbpth = Sheets("Control Sheet").Cells(folder_count, 1).Value With Application.FileSearch .LookIn = wkbpth .FileType = msoFileTypeExcelWorkbooks .Execute filecnt = .FoundFiles.Count 'Loop to count the number of sheets in each file For file_count = 1 To filecnt Application.Wait (Now + TimeValue("0:00:05")) Set wb = Workbooks.Open(Filename:=.FoundFiles(file_count)) Application.Wait (Now + TimeValue("0:00:05")) filenm = ActiveWorkbook.Name For sheet_count = 1 To Workbooks(filenm).Sheets.Count If Workbooks(filenm).Sheets(sheet_count).Name <> "Rejected" Then Workbooks(filenm).Sheets(sheet_count).Activate ActiveSheet.Columns("a:at").Select Selection.EntireColumn.Hidden = False shtnm = Trim(ActiveSheet.Name) lrow = ActiveSheet.Cells(65536, 11).End(xlUp).Row If lrow = 1 Then lrow = 2 For blank_row_count = 2 To lrow If ActiveSheet.Cells(blank_row_count, 39).Value = "" Then srow = ActiveSheet.Cells(blank_row_count, 39).Row Exit For End If Next blank_row_count For uid = srow To lrow ActiveSheet.Cells(uid, 40).Value = ActiveSheet.Name & uid Next uid ActiveSheet.Range("a" & srow & ":at" & lrow).Copy ThisWorkbook.Sheets("Consolidated Data").Activate alrow = ThisWorkbook.Sheets("Consolidated Data").Cells(65536, 11).End(xlUp).Row ThisWorkbook.Sheets("Consolidated Data").Range("a" & alrow + 1).Activate ActiveCell.PasteSpecial xlPasteValues ThisWorkbook.Sheets("Consolidated Data").Range("z" & alrow + 1).Value = shtnm ThisWorkbook.Sheets("Consolidated Data").Range("z" & alrow + 1 & ":z" & (alrow+lrow)).Select Selection.FillDown ThisWorkbook.Sheets("Consolidated Data").Range("ap" & alrow + 1).Value = wkbpth ThisWorkbook.Sheets("Consolidated Data").Range("ap" & alrow + 1 & ":ap" & (alrow + lrow)).Select Selection.FillDown ThisWorkbook.Sheets("Consolidated Data").Range("ao" & alrow + 1).Value = filenm ThisWorkbook.Sheets("Consolidated Data").Range("ao" & alrow + 1 & ":ao" & (alrow + lrow)).Select Selection.FillDown Workbooks(filenm).Sheets(sheet_count).Activate ActiveSheet.Range("am" & srow & ":am" & lrow).Value = "Picked" ActiveSheet.Columns("b:c").EntireColumn.Hidden = True ActiveSheet.Columns("f:f").EntireColumn.Hidden = True ActiveSheet.Columns("h:i").EntireColumn.Hidden = True ActiveSheet.Columns("v:z").EntireColumn.Hidden = True ActiveSheet.Columns("aa:ac").EntireColumn.Hidden = True ActiveSheet.Columns("ae:ak").EntireColumn.Hidden = True End If Next sheet_count Workbooks(filenm).Close True Next file_count End With Next folder_count Application.ScreenUpdating = True End Sub 

Thanks in advance for your help.

0

3 Answers 3

3

First off, make sure you have

Option Explicit 

at the top of your code so you can make sure you don't mess any of your variables up. This way, everything is dimensioned at the beginning of your procedure. Also, use variables for your workbooks, it'll clean up the code and make it more understandable, also, use indenting.

This worked for me, I found that I need to make sure the file isn't already open (assuming you aren't using an add-in) so you don't want to open the workbook with the code in it when it is already open):

Sub grab_data() Dim wb As Workbook, wbMacro As Workbook Dim filecnt As Integer, file_count As Integer Application.ScreenUpdating = False Application.EnableEvents = False Set wbMacro = ThisWorkbook With Application.FileSearch .LookIn = wbMacro.Path .FileType = msoFileTypeExcelWorkbooks .Execute filecnt = .FoundFiles.Count 'Loop to count the number of sheets in each file For file_count = 1 To filecnt If wbMacro.FullName <> .FoundFiles(file_count) Then Set wb = Workbooks.Open(Filename:=.FoundFiles(file_count)) Debug.Print wb.Name wb.Close True End If Next file_count End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

Hope that helps.

Try this (hope I didn't mess any of it up), basically, I'm checking to make sure the directory exists also, and I cleaned up the code quite a bit to make it more understandable (mainly for myself):

Sub grab_data() Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim i As Long Dim lRow As Long, lRowEnd As Long, lFolder As Long, lFilesTotal As Long, lFile As Long Dim lUID As Long Dim rng As Range Dim sWkbPath As String Dim wkb As Workbook, wkbTarget As Workbook Dim wksConsolidated As Worksheet, wks As Worksheet Dim v1 As Variant Set wkb = ThisWorkbook Set wksConsolidated = wkb.Sheets("Consolidated Data") 'Loop to find the number of excel files in the path in each row of the Control Sheet For lFolder = 2 To wksConsolidated.Cells(65536, 1).End(xlUp).Row sWkbPath = wksConsolidated.Cells(lFolder, 1).Value 'Check if file exists If Not Dir(sWkbPath, vbDirectory) = vbNullString Then With Application.FileSearch .LookIn = sWkbPath .FileType = msoFileTypeExcelWorkbooks .Execute lFilesTotal = .FoundFiles.Count 'Loop to count the number of sheets in each file For lFile = 1 To lFilesTotal If .FoundFiles(lFile) <> wkb.FullName Then Set wkbTarget = Workbooks.Open(Filename:=.FoundFiles(lFile)) For Each wks In wkbTarget.Worksheets If wks.Name <> "Rejected" Then wks.Columns("a:at").EntireColumn.Hidden = False lRowEnd = Application.Max(ActiveSheet.Cells(65536, 11).End(xlUp).Row, 2) v1 = Application.Transpose(wks.Range(Cells(2, 39), Cells(lRowEnd, 39))) For i = 1 To UBound(v1) If Len(v1(i)) = 0 Then lRow = i + 1 Exit For End If Next i v1 = Application.Transpose(wks.Range(Cells(lRow, 40), Cells(lRowEnd, 40))) For lUID = 1 To UBound(v1) v1(lUID) = wks.Name & lUID Next lUID Application.Transpose(wks.Range(Cells(lRow, 40), Cells(lRowEnd, 40))) = v1 wks.Range("a" & lRow & ":at" & lRowEnd).Copy i = wksConsolidated.Cells(65536, 11).End(xlUp).Row With wksConsolidated .Range("A" & i).PasteSpecial xlPasteValues Application.CutCopyMode = False .Range("z" & i + 1).Value = wks.Name .Range("z" & i + 1 & ":z" & i + lRowEnd).FillDown .Range("ap" & i + 1) = sWkbPath .Range("ap" & i + 1 & ":ap" & i + lRowEnd).FillDown .Range("ao" & i + 1) = wkbTarget.FullName .Range("ao" & i + 1 & ":ao" & (i + lRowEnd)).FillDown End With With wks .Range("am" & lRow & ":am" & lRowEnd) = "Picked" .Columns("b:c").EntireColumn.Hidden = True .Columns("f:f").EntireColumn.Hidden = True .Columns("h:i").EntireColumn.Hidden = True .Columns("v:z").EntireColumn.Hidden = True .Columns("aa:ac").EntireColumn.Hidden = True .Columns("ae:ak").EntireColumn.Hidden = True End With End If Next wks wkbTarget.Close True End If Next lFile End With End If Next lFolder Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub 
Sign up to request clarification or add additional context in comments.

Comments

1

There may be two issues here

The macro runs perfectly on my system but not on the users systems

I presume you are running this in xl2003 as Application.FileSearch was deprecated in xl2007. So you are probably best advised to use a Dir approach instead to ensure your code works on all machines. Are you users all using xl2003?

You will get a "Object doesn't support this action" error in xl2007/10

The error i am receiving during the looping process is "Runtime Error '9' Subscript out of range

Is this error occuring on your machine, or on one/all of the user machines?

1 Comment

All the users are using xl2003 and the error is not poping up on my machine but all of the users are getting this error.
1

Ok guys,

I have finally been able to figure out the problem.

This error is occuring because some of the files in the raw data folder are corrupted and get locked automatically. So when the macro on opening the file gets an error and stops there.

I have now made a change to the macro. It would now first check if the files are all ok to be imported. If there is a corrupt file then it would list down their names and the user will be required to manually open it and then do a "save As" and save a new version of the corrupt file and then delete it.

Once this is done then the macro does the import of the data.

I am putting down the code below for testing the corrupt files.

 Sub error_tracking() Dim srow As Long Dim rawfilepth As Integer Dim folder_count As Integer Dim lrow As Long Dim wkbpth As String Dim alrow As Long Dim One_File_List As String Application.ScreenUpdating = False Application.DisplayAlerts = False ThisWorkbook.Sheets("Control Sheet").Activate rawfilepth = Sheets("Control Sheet").Cells(65536, 1).End(xlUp).Row Sheets("Control Sheet").Range("E2:E100").Clear 'Loop to find the number of excel files in the path 'in each row of the Control Sheet For folder_count = 2 To rawfilepth wkbpth = Sheets("Control Sheet").Cells(folder_count, 1).Value One_File_List = Dir$(wkbpth & "\*.xls") Do While One_File_List <> "" On Error GoTo err_trap Workbooks.Open wkbpth & "\" & One_File_List err_trap: If err.Number = "1004" Then lrow = Sheets("Control Sheet").Cells(65536, 5).End(xlUp).Row Sheets("Control Sheet").Cells(lrow + 1, 5).Value = One_File_List Else Workbooks(One_File_List).Close savechanges = "No" End If One_File_List = Dir$ Loop Next folder_count If Sheets("Control Sheet").Cells(2, 5).Value = "" Then Call grab_data Else MsgBox "Please check control sheet for corrupt file names.", vbCritical, "Corrupt Files Notification" End If Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

This may not be one of the cleanest codes around, but it gets the job done. For those who have been troubled by this problem this is one of the ways to get around this problem. For those who havae a better way of doing this please respond with your codes.

Thanks to all for helping me out!!!!

Comments

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.