PDA

View Full Version : Error handler not working



amyincalgary
01-22-2009, 08:41 AM
Hi. I have code that prompts the user to select multiple files and these files are opened, data is copied, then pasted into the main workbook. If there is no data in the file the data file should close and the next one opens. If I have more than one data file that is empty it errors out. ie It opens the first file which has no data so it closes, the second file which has no data i opened but then errors out. The funny thing is, if I only select 1 file to open (the 2nd file with no data), it works fine. I run into problems when there is more than file that has no data. Not sure what to do?!? Here is the code:


Sub Copy_Rawdata()

Dim file_counter As Integer

file_counter = 1 ' sets the file_counter to first position in the array of filenames

'removes all data from area where the raw data is to be copied
DataRaw.Activate
Cells.Clear

' prompts the user to select the csv files which contain the data _
then writes the file names to an array with the initial name as position 1


ChDrive ("N")
ChDir "N:\----"

filetoopen = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "Select Raw Data Files", , True)
If IsArray(filetoopen) = False Then
Exit Sub
End If
CurrentBookName = ActiveWorkbook.Name

For Each Currelement In filetoopen

Workbooks.OpenText Filename:=filetoopen(file_counter), DataType:=xlDelimited, comma:=True, local:=True ' opens the file
RawData = ActiveWorkbook.Name

On Error GoTo NoData
Range("A1").Select
Selection.AutoFilter Field:=1, Criteria1:="CA*"
Selection.AutoFilter Field:=14, Criteria1:="<>DE"
Range("A1").EntireColumn.Select
Selection.Find(What:="CA*").Select

FirstRow = ActiveCell.Row

Rows(FirstRow & ":" & Range("A" & FirstRow).End(xlDown).Row()).Copy
Workbooks(CurrentBookName).Sheets("CompileData").Activate

If file_counter = 1 Then
Range("A1").Select
Else
Selection.End(xlDown).Select
End If
Selection.Offset(1, 0).Select
ActiveSheet.Paste

NoData:
Workbooks(Workbooks.Count).Close 'closes the current workbook

file_counter = file_counter + 1

Next

End Sub


Edit Lucas: VBA tags added to code. You can select your code when posting and hit the vba button to format it for the forum.

Bob Phillips
01-22-2009, 09:03 AM
I must say that I really don't like that sort of error hadnling method, branching off and just continuing, but if you must use it, I would change the Goto Nodata to Resume NoData, and put the error statement b efore the For loop start.

If that fails, can you post some example files o work on?

amyincalgary
01-22-2009, 12:26 PM
Thanks xld. When I changed it as you suggested, I got an error. Here are 3 files, 1 with data, 2 without. Thanks!

Bob Phillips
01-22-2009, 02:48 PM
Sub Copy_Rawdata()
Dim File_Counter As Long
Dim FirstRow As Long
Dim FileToOpen As Variant
Dim CurrElement As Variant
Dim CurrentBookName As String
Dim RawData As String

File_Counter = 1 ' sets the file_counter to first position in the array of filenames

'removes all data from area where the raw data is to be copied
DataRaw.Activate
Cells.Clear

' prompts the user to select the csv files which contain the data _
Then writes the file names To an array With the initial name As position 1

ChDrive ("N")
ChDir "N:\----"

FileToOpen = Application.GetOpenFilename("CSV Files (*.csv),*.csv", , "Select Raw Data Files", , True)
If IsArray(FileToOpen) = False Then

Exit Sub
End If
CurrentBookName = ActiveWorkbook.Name

On Error Resume Next
For Each CurrElement In FileToOpen

Workbooks.OpenText Filename:=FileToOpen(File_Counter), DataType:=xlDelimited, comma:=True, local:=True ' opens the file
RawData = ActiveWorkbook.Name

With Range("A1")

.AutoFilter Field:=1, Criteria1:="CA*"
.AutoFilter Field:=14, Criteria1:="<>DE"
.EntireColumn.Find(What:="CA*").Select
End With

FirstRow = ActiveCell.Row

Rows(FirstRow & ":" & Range("A" & FirstRow).End(xlDown).Row()).Copy
Workbooks(CurrentBookName).Sheets("CompileData").Activate

If File_Counter = 1 Then

Range("A1").Select
Else

Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
End If
ActiveSheet.Paste

NoData:
Application.CutCopyMode = False
Workbooks(Workbooks.Count).Close savechanges:=False 'closes the current workbook
File_Counter = File_Counter + 1
Next

End Sub

amyincalgary
01-23-2009, 09:36 AM
Thanks xld. It worked great with the files I provided you but when I ran it with more files, there were 2 files where all of the rows were DE (ie .AutoFilter Field:=14, Criteria1:="<>DE") and it copies the header, so the header is showing up twice. Any suggestions for this? I've attached sample files. THANKS!