Dear Jason,
You have shown me a much more elegant way of collecting the values of "mylist" and "myfilename" my problem is where in the code do I place the on error "filenotfound" section to make the sub run with new values.
I have included the whole sub so that you can get the overview.
Thanks
Peter
Sub testimport()
'
'
Dim mylist, myFilename As String
Dim myLen As Integer
Workbooks.Open Filename:= _
"C:\Users\Peter Taylor\Documents\testdata\openfile.xlsx"
'Range("A1").Select
'mylist = ActiveCell.Value
'myLen = Len(mylist)
'ActiveCell.Offset(0, 1).Select
'myFilename = ActiveCell.Value
'ActiveCell.Offset(0, -1).Select
a = 1
mylist = Cells(a, 1).Value
myFilename = Cells(a, 2).Value
Do While myLen > 0
On Error GoTo FileNotFound
Workbooks.OpenText Filename:=mylist, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
, Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
FileNotFound:
Windows("openfile.xlsx").Activate
ActiveCell.Offset(1, 0).Select
mylist = ActiveCell.Value
myLen = Len(mylist)
ActiveCell.Offset(0, 1).Select
myFilename = ActiveCell.Value
ActiveCell.Offset(0, -1).Select
Workbooks.OpenText Filename:=mylist, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _
, Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)), TrailingMinusNumbers:=True
Cells.Find(What:="H1000", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'MsgBox "The active cell row is " & ActiveCell.Row
Dim myID As Integer
myID = ActiveCell.Row
Rows(myID).Select
Selection.Copy
Range("A18").Select
Selection.End(xlUp).Select
Selection.Insert Shift:=xlDown
Cells.Find(What:="H1001", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
myID = ActiveCell.Row
Rows(myID).Select
Selection.Copy
Range("A2").Select
Selection.Insert Shift:=xlDown
Rows("3:3").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'concatenate fields iterate until no values left in the top row
Dim myCounter, myH1000Len, MyH1001Len As Integer
Range("A1").Select
myH1000Len = Len(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
MyH1001Len = Len(ActiveCell.Value)
ActiveCell.Offset(-1, 0).Select
myCounter = 0
Do While myH1000Len > 0
ActiveCell.Offset(2, 0).Select
myCounter = myCounter + 1
If MyH1001Len > 0 Then
ActiveCell.FormulaR1C1 = "=R[-2]C&""_""&R[-1]C"
Else
ActiveCell.Offset(-2, 0).Select
Selection.Copy
ActiveCell.Offset(2, 0).Activate
ActiveSheet.Paste
End If
ActiveCell.Offset(-2, 1).Select
myH1000Len = Len(ActiveCell.Value)
ActiveCell.Offset(1, 0).Select
MyH1001Len = Len(ActiveCell.Value)
ActiveCell.Offset(-1, 0).Select
Loop
Range("G7").Select
ActiveCell.Value = myCounter
' do the rest of the ops here
myFilename = "C:\Users\Peter Taylor\Documents\testdata\data\" & myFilename
'select control finished
'Windows("openfile.xlsx").Activate
'MsgBox myFilename
ActiveWorkbook.SaveAs Filename:=myFilename, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
mylist = Cells(a, 1).Value
myFilename = Cells(a, 2).Value
ActiveWorkbook.Close
Windows("openfile.xlsx").Activate
a = a + 1
mylist = Cells(a, 1).Value
myFilename = Cells(a, 2).Value
'ActiveCell.Offset(1, 0).Select
'mylist = ActiveCell.Value
'myLen = Len(mylist)
'ActiveCell.Offset(0, 1).Select
'myFilename = ActiveCell.Value
'ActiveCell.Offset(0, -1).Select
Loop
End Sub