It almost Works is seems to load and create the spread sheet. But Once doneI get an excel error report occurs and excel is dropped. Can anyone see the problem ...
Sub test()
Dim v As Integer, w As Integer, x As String, y As Integer
Dim z As Integer, a As Integer
Dim fn As WorksheetFunction
Dim CellArray, CommaPos, TempArray
Set fn = Application.WorksheetFunction
' Sheets("Input Format").Cells(2, 7) = "0, 2,10, 2, 40, 9, 52, 9,64, 9,75, 9,88, 1"
x = Sheets("Input Format").Cells(2, 7)
y = Len(x) - Len(fn.Substitute(x, ",", ""))
If y Mod 2 = 0 Then
MsgBox "Uneven Pairing"
Exit Sub
End If
z = (y + 1) / 2
ReDim TempArray(1 To y + 1)
ReDim CommaPos(1 To y)
ReDim CellArray(1 To z, 1 To 2)
For v = 1 To y
If v = 1 Then
CommaPos(v) = fn.Search(",", x)
TempArray(v) = Left(x, CommaPos(v) - 1)
Else
CommaPos(v) = fn.Search(",", x, CommaPos(v - 1) + 1)
TempArray(v) = Mid(x, CommaPos(v - 1) + 1, CommaPos(v) - CommaPos(v - 1) - 1)
End If
Next v
TempArray(y + 1) = Right(x, Len(x) - CommaPos
)
For w = 1 To y + 1
If w Mod 2 = 1 Then
a = w 2 + 1
CellArray(a, 1) = TempArray(w)
Else
a = w 2
CellArray(a, 2) = TempArray(w)
End If
Next w
Fillnm = Application.GetOpenFilename(Filefilter:="Report Doc(*.doc),*.doc", Title:=Reprt + " Report")
'Workbooks.OpenText Filename:=Fillnm, _
' Origin:=xlWindows, StartRow:=RptStart, DataType:=xlFixedWidth, FieldInfo:= _
' Array(Array(0, 2), Array(10, 2), Array(40, 9), Array(52, 9), Array(64, 9), Array(75, 9), Array(88, 1))
Workbooks.OpenText Filename:=Fillnm, _
Origin:=xlWindows, StartRow:=8, DataType:=xlFixedWidth, FieldInfo:=CellArray
End Sub