Copy part of text file
With Range("A3:AZ33")
On Error Resume Next
.SpecialCells(xlCellTypeConstants).ClearContents
.SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
End With
Before I tell you where I think your problem is, let me address the above
from your code. If you are clearing all cells with either formulas or
constants in the range A3:AZ33, then why do them individually? I think this
single line replacement for the above would be simpler and quicker to
execute...
Range("A3:AZ33").ClearContents
If LCase(Right(FilesInPath, 10)) Like "File*.txt" Then
Now, as for your problem, I think it lies in the above line of code. You are
comparing all lower case text on the left with text that starts with an
upper case letter on the right... they will never match via the Like
operator... change the "F" on the right side to "f" and that will make that
portion of your code work. Just so you know, as you have this line of code
structured, the asterisk on the right side is a wildcard for only 0, 1 or 2
characters.. is that what you wanted? (Just checking to make sure you
realize that the ".txt" after the asterisk is counted as part of the 10
characters to the right of the contents of the FilesInPath variable.)
I looked, but wasn't completely sure what the rest of your code was doing;
however, I think it can be simplified. Can you explain in words exactly what
you are trying to have your code accomplish (don't tell us what your own
code is doing, rather, tell us what you have and what you want as a final
result afterwards).
--
Rick (MVP - Excel)
"Steve" wrote in message
...
Hello
I am trying to open a CSV file (File*.*) and copy a portion out of
that file into my work book. It runs up to the point of opening the
files. What is wrong with my code?
rnum = 1
Fnum = 1
MyPath = "C:\path\file"
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If
FilesInPath = Dir(MyPath & "File*.*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
On Error GoTo CleanUp
Set basebook = ThisWorkbook
With Range("A3:AZ33")
On Error Resume Next
.SpecialCells(xlCellTypeConstants).ClearContents
.SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
End With
rnum = 0
Fnum = 0
Do While FilesInPath < ""
If LCase(Right(FilesInPath, 10)) Like "File*.txt" Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
End If
FilesInPath = Dir()
Loop
If Fnum 0 Then
Call SortArray(MyFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Workbooks.OpenText Filename:="(MyPath & MyFiles(Fnum)",
Origin:=437 _
, 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)),
TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True,
OtherChar _
:=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1),
Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1),
Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1),
Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1),
Array(23, 1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1),
Array(30, 1), Array(31, 1)) _
, TrailingMinusNumbers:=True
Rows("1:1").Select
Selection.Insert Shift:=xlDown,
CopyOrigin:=xlFormatFromLeftOrAbove
Range("F1").Select
Range("F1").Formula = "=SUMPRODUCT(--($b$2:$b$500=""TEST""),(f
$2:f$500))"
Range("f1").AutoFill Range("F1:AE1")
Call SortArray(MyFiles)
SourceRcount = sourceRange.Rows.Count
With sourceRange
'this is the column
Set destrange = basebook.Worksheets(1).Cells(rnum + 2,
"AC"). _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
Thanks
|