Capture the second error

[PeterTaylor]

Dear All
I have the following code that Steps throught a spreadsheet and progressively opens and munipulates some text files. Te error trap is for when the file does not exist. It will work find for the first instance but not for the second. Reading around the forum I gather that the sub is still in a state of "error" and cannot handle the second. The resume command is supposse to help but I do not know where it needs to be inserted.

Any help would be appreciated
Regards
Peter
PS the following code has been kindly overhauled by Jasonb75 my original attempt was much more pedestrian:

Sub testimport3()
' Declare variables, open "openfile", define starting row for mylist

Dim mylist As String, myFilename As String, aRow As Integer, bCol As Integer, TestBlank As Integer, zRow As Integer, ZCol As Integer
Workbooks.Open Filename:="C:\Users\Peter Taylor\Documents\testdata\errortrap.xlsx"
Workbooks.Open Filename:="C:\Users\Peter Taylor\Documents\testdata\openfile.xlsx"
aRow = 1
zRow = 1
ZCol = 1
' Start loop
Do
' Define values to mylist and myFilename for current pass of Do - Loop cycle
mylist = Cells(aRow, 1).Value
myFilename = Cells(aRow, 2).Value
' check length of current mylist value,for a zero length
If Len(mylist) = 0 Then
' in case of stray blanks in unsorted data, check next 10 rows
If TestBlank < 10 Then
TestBlank = TestBlank + 1
' kick back to loop start
GoTo NoError:
Else
MsgBox "Blank found in mylist at " & Cells(aRow, 1).Address & " Procedure will now exit"
Exit Do
End If
End If
' a valid entry needed to get here so reset testblank to 0
TestBlank = 0
' for a non zero length value of mylist, report current value to user and attempt to open file

On Error GoTo FileNotFound
'MsgBox "Opening " & mylist
Workbooks.OpenText mylist, xlMSDOS, 1, xlDelimited, xlDoubleQuote, Tab:=True, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1))
' Search for H1000 copy containing row to A18, end up

Cells.Find("H1000", , xlFormulas, xlPart).Activate
'MsgBox "The active cell row is " & ActiveCell.Row
Rows(ActiveCell.Row).Copy
Range("A18").Select
Selection.End(xlUp).Select
Selection.Insert Shift:=xlDown
' Search for H1001 copy containing row to A2

Cells.Find("H1001", , xlFormulas, xlPart).Activate
Rows(ActiveCell.Row).Copy
Range("A2").Insert
' insert blank into row 3
Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
' define col 1 to start concatenation array
bCol = 1
' set to run while row 1 not blank
While Len(Cells(1, bCol)) > 0
' set formula if row 2 not blank, else copy row 1 into row 3
If Len(Cells(2, bCol)) > 0 Then
Cells(3, bCol).FormulaR1C1 = "=R[-2]C&""_""&R[-1]C"
Else: Cells(3, bCol) = Cells(1, bCol)
End If
' next column
bCol = bCol + 1
Wend
' on exit bCol will be on the first empty column, bCol - 1 = last used column and counter value
Range("G7") = bCol - 1
' concatenate string myFilename to filepath, save and close
myFilename = "C:\Users\Peter Taylor\Documents\testdata\data\" & myFilename
ActiveWorkbook.SaveAs Filename:=myFilename, FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
' if code has reached this point then no error so bypass error handle
GoTo NoError
' error handle
FileNotFound:
' Report error to user

'MsgBox "File " & mylist & " was not found, moving to next file"
Windows("errortrap.xlsx").Activate
Cells(zRow, ZCol).Select
ActiveCell.Value = mylist
ZCol = ZCol + 1
Cells(zRow, ZCol).Select
ActiveCell.Value = "File not Found"
ZCol = ZCol - 1
zRow = zRow + 1


NoError:
' increase row and look to next mylist entry
aRow = aRow + 1
' return to "openfile"
Windows("openfile.xlsx").Activate
' restart loop
Loop
End Sub

 

[PeterTaylor]

Dear Moderator,
Could you please delete this thread it is a new thread started, in error from, an old htread called "error".
my apologies
Peter Taylor

 

[Peter_SSs]

We generally do not delete threads. However, this thread has been 'Closed' following your request.

Please continue in the original error thread.