Capture the second error

Status
Not open for further replies.

PeterTaylor

Board Regular
Joined
Aug 5, 2010
Messages
158
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
 

Some videos you may like

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

PeterTaylor

Board Regular
Joined
Aug 5, 2010
Messages
158
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,918
Office Version
365
Platform
Windows
We generally do not delete threads. However, this thread has been 'Closed' following your request.

Please continue in the original error thread.
 
Status
Not open for further replies.

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,006
Messages
5,508,750
Members
408,692
Latest member
OptimalKR

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top