Solved: Problems with an Error Handler

[Poundland]

Guys,

I have 333 different files that I need to consolidate data from into 1 file, these files are variable by date, but I am encountering that when dated files are missing an error occurs. My current error routine only works once....

I have an issue trying to get an error handler to work correctly, my problem is that I am not exiting the Handler routine correctly because when I encounter the error the routine goes to another code line which then sends the routine through the next loop which in itself solves the error. BUT my error will only work once, if the same error is encountered it performsa a runtime error and falls over.

Can you help?

My code.

Sub copyqadata()
Dim strDate As String

For a = 1 To 333
On Error GoTo Line2
strDate = Format(Date - a, "yyyy_mm_dd")

Workbooks.Open("P:\H935 Quality Assurance\QA allocations\QA Allocation_" & strDate).Activate
Selection.Offset(1, 0).Select
If ActiveCell = "" Then GoTo line1 Else
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.Copy
Windows("Book1").Activate
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste

line1:
Workbooks.Open("P:\H935 Quality Assurance\QA allocations\QA Allocation_" & strDate).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close (False)

Line2:
Next a
End Sub

[Bob Phillips]

Sub copyqadata()
Const ROOT_PATH As String = _
"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long

For a = 1 To 333
strDate = Dir(ROOT_PATH & Format(Date - a, "yyyy_mm_dd"))
If strDate <> "" Then

Workbooks.Open(strDate).Activate
Selection.Offset(1, 0).Select
If ActiveCell <> "" Then
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.Copy
Windows("Book1").Activate
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Workbooks.Open(strDate).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close False
End If
Next a
End Sub

[Poundland]

Sub copyqadata()
Const ROOT_PATH As String = _
"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long

For a = 1 To 333
strDate = Dir(ROOT_PATH & Format(Date - a, "yyyy_mm_dd"))
If strDate <> "" Then

Workbooks.Open(strDate).Activate
Selection.Offset(1, 0).Select
If ActiveCell <> "" Then
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.Copy
Windows("Book1").Activate
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Workbooks.Open(strDate).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close False
End If
Next a
End Sub


Xl,

I have tried this code but it does not work for me, when checking for the file it simply goes into the constant For Next check loop as if the file does not exist, when I know that it does..

Any ideas?

[Bob Phillips]

Small error



Sub copyqadata()
Const ROOT_PATH As String = _
"C:\test\QA Allocation_"
'"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long

For a = 1 To 333
strDate = Dir(ROOT_PATH & Format(Date - a, "yyyy_mm_dd") & ".xls", vbNormal)
If strDate <> "" Then

Workbooks.Open strDate
Selection.Offset(1, 0).Select
If ActiveCell <> "" Then
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.Copy
Windows("Book1").Activate
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Workbooks.Open(strDate).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close False
End If
Next a
End Sub

[Poundland]

Sorry XL, not sure how this is going to work, I do not have a Path "C:\Test\QA Allocation" ??

And surely this is the path you are trying to pull the workbook from?

[Bob Phillips]

That was juts for my testing, change



Sub copyqadata()
Const ROOT_PATH As String = _
"C:\test\QA Allocation_"
'"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long


to



Sub copyqadata()
Const ROOT_PATH As String = _
"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long

[Poundland]

That was juts for my testing, change



Sub copyqadata()
Const ROOT_PATH As String = _
"C:\test\QA Allocation_"
'"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long


to



Sub copyqadata()
Const ROOT_PATH As String = _
"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long


Sorry this still does not work, again it simply loops through the For Next function as if the file does not exist, when I know that it does :banghead:

[Kenneth Hobs]

Post your full code please.

For:
strDate = Dir(ROOT_PATH & Format(Date - a, "yyyy_mm_dd") & ".xls", vbNormal)
Add this and play:
debug.print ROOT_PATH & Format(Date - a, "yyyy_mm_dd") & ".xls"
Workbooks.Open ROOT_PATH & Format(Date - a, "yyyy_mm_dd") & ".xls"
exit sub

If the workbook opened, you know that it did exist. However, I don't see DIR failing if the file exists. Even if the workbook failed to open, you can see what path you are sending to DIR in VBE's Immediate window.

[Bob Phillips]

Well it worked for me so I am stumped.

[Poundland]

Well it worked for me so I am stumped.


Xl,

Thanks for your help, I made the following changes to your code and it worked.

Sub copyqadataroot()
Const ROOT_PATH As String = _
"P:\H935 Quality Assurance\QA allocations\QA Allocation_"
Dim strDate As String
Dim a As Long

For a = 1 To 333
strDate = Dir(ROOT_PATH & Format(Date - a, "yyyy_mm_dd") & ".xls", vbNormal)
If strDate <> "" Then
' Workbooks.Open strDate
Workbooks.Open ("P:\H935 Quality Assurance\QA allocations\" & strDate)
Selection.Offset(1, 0).Select
If ActiveCell <> "" Then
Cells(1, 1).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.Copy
Windows("Book1").Activate
Cells(1, 1).Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Workbooks.Open("P:\H935 Quality Assurance\QA allocations\" & strDate).Activate
' Workbooks.Open(strDate).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close False
End If
Next a
End Sub

[Bob Phillips]

Ah yes, I messed up her, Dir doesn't return the path. I had commented out the open in my code, so I didn't hit that problem. Your explanation in post #7 threw me as you were saying the Dir didn't work, which it did.