Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy part of text file
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy part of text file
Not sure why I did the separate clears (constand and then formulae).
This is a copy of old code. I dont have network access so I cant test changes, but your comments on If LCase(Right(FilesInPath, 10)) Like "File*.txt" Then comments have me thinking and I believe I have a fix, again a result of copying old code. I will test tomorrow and post results. Thanks for the response! |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy part of text file
OK So I'm sure now that it is the If LCase(Right(FilesInPath, 10))
Like "File*.txt" Then bit that is getting me but Im not sure how to fix it... Here is the deal... I need to open a specific set of daily files in the target folder. The file name is constructed as such, abcYYYYMMDD.txt. The year and month are input earlier in the routine and is working for that particular section of the routine. They are both input as strings sYear and sMonth. I need to open each file for the input year and month, insert a blank row at the top and insert the formula =SUMPRODUCT(--($b$2:$b$500="TEST"),(f$2:f$500)) in F1:AE1. Then copy F1:AE1 to my base book starting in AC3:AZ3, the next file will paste into AC4:AZ4 and so on. So how do I modify If LCase(Right(FilesInPath, 10)) Like "File*.txt" I'm guessing that I should change it to Left and use abc and sYear and sMonth some how but not sure exacly how. Thanks! |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Copy part of text file
OK been tweaking and this is what I have so far...
rnum = 1 Fnum = 1 MyPath = "\\server\shares\groupdirs\923\hourlydata" If Right(MyPath, 1) < "\" Then MyPath = MyPath & "\" End If FilesInPath = Dir(MyPath & "abc*.*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If On Error GoTo CleanUp rnum = 0 Fnum = 0 Do While FilesInPath < "" sFileName = "abc_" & sYear & sMonth If LCase(Left(FilesInPath, 10)) Like sFileName Then Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath End If FilesInPath = Dir() Loop 'Loop through all files in the array(myFiles) 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 Set mybook = ThisWorkbook 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=""Criteria""),(f$2:f$500))" Range("f1").AutoFill Range("F1:AE1") Set sourceRange = mybook.Worksheets(1).Range("F1:AE1") Call SortArray(MyFiles) SourceRcount = sourceRange.Rows.Count Set destrange = basebook.Worksheets(1).Range("AC" & rnum) basebook.Worksheets(1).Cells(rnum + 2, "A").Value = mybook.Name With sourceRange 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 CleanUp: Application.ScreenUpdating = True End Sub Sub SortArray(myArr As Variant) Dim iCtr As Long Dim jCtr As Long Dim Temp As Variant For iCtr = LBound(myArr) To UBound(myArr) - 1 For jCtr = iCtr + 1 To UBound(myArr) If LCase(Right(myArr(iCtr), 10)) _ LCase(Right(myArr(jCtr), 10)) Then Temp = myArr(iCtr) myArr(iCtr) = myArr(jCtr) myArr(jCtr) = Temp End If Next jCtr Next iCtr End Sub It runs up to the point of Set destrange = basebook.Worksheets(1).Range("AC" & rnum) and then exits. Any ideas? Thanks |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copy selected part number of text from one cell into another cell | Excel Discussion (Misc queries) | |||
Is there an easy way to open a text file and modify only a part of it? | Excel Programming | |||
excel - create a macro to use cell text as part of a file name | New Users to Excel | |||
Use Macro to copy part of text in cell | Excel Programming | |||
import part of a text file | Excel Programming |