Read Text File into Excel Using VBA

Hi All,

I'm a new VBA programmer.  I know how to pull an entire text file
into an Excel Spreadsheet, but I only want specific information from
the text file not the entire text file.

What I have is about 25 text files stored in a folder, let's say
C:\test.

Each file is named by a property address as follows:
209 MAIN ST.txt
213 MAIN ST.txt
111 ELM ST.txt
2356 WOOD AVE.txt

On the 11th row of each file is as follows:
Property Address:209 MAIN ST
On the 31st row of each file is as follows:
Total Value:30500

What I would like to do is read each file located in the "C:\test
folder and write a record (row) into a single Excel Spreadsheet for
each property.  I would like the Excel Spreadsheet to look as follows
once completed.  Note the 1st row below is a header row that needs to
be generated by the code.

Property Address	Total Value
209 MAIN ST	        30500
213 MAIN ST	        60700
111 ELM ST	        20400
2356 WOOD AVE	        20900

Can I read a header list (in a spreadsheet, text file, or hard coded in
the code) which I would prefer the spreadsheet or text file method,
write the header row in A1 then B1.  Next read the 25 text files and
search based on the header info written above (Property Address & Total
Value) and write the appropriate to the single spreadsheet. The 11th
row of the First text file value written in cell A2, then read the 31st
row of the First text file write the value in cell B2, then loop to the
Second text file and values from The 11th row of the Second text file
value written in cell A3, then read the 31st row of the Second text
file write the value in cell B3, so on and so forth until the last text
file is read and the last record is written.
I know this is elementary to most, but I'm a beginner programmer and
sure could use the help...
Can any one help?

Thanks in advance.

Willie T

0
google3775 (11)
1/5/2005 5:57:04 PM
excel.misc 78881 articles. 5 followers. Follow

13 Replies
782 Views

Similar Articles

[PageSpeed] 17

Ok, I have a Routine that will read a user defined folder via an
InputBox and get a list of all the files in that folder.

Next I pass that info to a Routine that Reads the Full Text files into
individual Excel spreadsheets, so I've made some progress.

My problems left to resolve:
1.	I want to read into one single spreadsheet not 25 (i.e. 25 text
files into a single spreadsheet)
2.	I want 1 header line in the one spreadsheet
3.	I want only select info out of each text file not the entire text
file.

Can I read the 11th line in each of the text file and import ONLY the
text behind the semicolon?
For example, the 11th line in each file is as follows:
Property Address:209 MAIN ST
I only want to import "209 MAIN ST" from the 11th line in each text
file and place the first entry in A2 of the Excel Spreadsheet, then
read the next file and place that Property Address in Cell A3 until all
text files are read.

Can anyone help or direct me to a group that can.

Code is listed below.  Keep in mind that since the code is snippets, it
still need some clean up.

Thanks in advance.

Willie T

Dim MyFileSystemObject As Object 'fs
Dim MyFolderObject As Object 'f
Dim MyFileObject As Object 'f1
Dim MyFileCollection As Object 'fc
Sub LoopThroughInputFiles()
Dim RoutineStartSecondCount As Long
Dim ThisFileFinishSecondCount As Long
Dim AverageSecondsPerFile As Long
Dim StringToDebugPrint As String

RoutineStartSecondCount = Int(Timer) 'int of seconds elapsed since
midnight

FolderContainingRawFiles = InputBox("Enter Name, c/w Path, of Folder
Containing Raw Files")

FileCounter = 0 'initialise

'Dim MyFileSystemObject As Object 'fs
'Dim MyFolderObject As Object 'f
'Dim MyFileObject As Object 'f1
'Dim MyFileCollection As Object 'fc

Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject")
'MyFileSystemObject is a filesystemobject
Set MyFolderObject =
MyFileSystemObject.GetFolder(FolderContainingRawFiles)  'MyFolderObject
is the folder object

Set MyFileCollection = MyFolderObject.Files 'fc is the collection of
file objects in folder object f

For Each MyFileObject In MyFileCollection
FileToWorkWith = MyFileObject.Name
'Now call function/sub to work with file...
'FunctionToOpenAndWorkWithFile
ReadFullTextFile


FileCounter = FileCounter + 1
ThisFileFinishSecondCount = Int(Timer)
AverageSecondsPerFile = (ThisFileFinishSecondCount -
RoutineStartSecondCount) / FileCounter
StringToDebugPrint = FileCounter & " files (of about "
StringToDebugPrint = StringToDebugPrint &
MyFileCollection.Count
StringToDebugPrint = StringToDebugPrint & ") done so far;
time remaining "
StringToDebugPrint = StringToDebugPrint &
Format((AverageSecondsPerFile * (MyFileCollection.Count - FileCounter)
/ 60), "0.0")
StringToDebugPrint = StringToDebugPrint & " minutes"
StringToDebugPrint = StringToDebugPrint & " (average " &
Int(AverageSecondsPerFile)
StringToDebugPrint = StringToDebugPrint & " seconds/file)"
Debug.Print StringToDebugPrint

Next
Debug.Print "File Addition Finished (at last!) " & Date & ", " &
Time
End Sub


Sub ReadFullTextFile()

Dim oExcel As Object
Dim oBook As Object
Dim osheet As Object

Dim filename As String

Set oExcel = CreateObject("Excel.Application")

' Open text file
'filename = "c:\MAIN-ST-205.txt"
'Set oBook = oExcel.Workbooks.Open(filename)
Set oBook = oExcel.Workbooks.Open(MyFileObject)
Set oBook = oExcel.ActiveWorkbook

oBook.Sheets(1).Activate
Set osheet = oBook.Sheets(1)

'Set osheet = oBook.ActiveSheet
' Make Excel visible
oExcel.Visible = True
oExcel.UserControl = True

' save as excel workbook
'filename2 = "c:\MAIN-ST-205.xls"
filename2 = (MyFileObject) & ".xls"
oBook.SaveAs filename2, 1

' ***** At this point I would like to run a macro, however they are
'not available in the macro window or within this code.
Set oExcel = Nothing
Set oBook = Nothing

'End
End Sub

0
google3775 (11)
1/5/2005 6:00:41 PM
First, you wrote semicolon, but typed a colon (:).  I'm guessing your sample is
correct.

And if you have a key value in your text file, you could use that key instead of
counting records.  (Counting records is fine if there's no other way--but if
someone edits a single file and deletes/inserts a line, then the code will break
down pretty fast.  I'd believe the key (as long as it's unique???).)

And since you're running this from excel, you don't need to create another
instance of excel.  You can just have another workbook open in that same
instance.

And you can read a text file using "Open xxx For Input As ###" and read each
line looking for what you want.

And there's lots of ways to get the list of .txt files from a single folder.  I
used a different one from yours.

If this seems to make sense, then how about this:

Option Explicit
Sub testme()
   
    Dim myFiles() As String
    Dim fCtr As Long
    Dim myFile As String
    Dim myPath As String
    Dim wkbk As Workbook
    Dim wks As Worksheet
   
    'change to point at the folder to check
    myPath = "c:\my documents\excel"
    If Right(myPath, 1) <> "\" Then
        myPath = myPath & "\"
    End If
    
    myFile = Dir(myPath & "*.txt")
    If myFile = "" Then
        MsgBox "no files found"
        Exit Sub
    End If
    
    'get the list of files
    fCtr = 0
    Do While myFile <> ""
        fCtr = fCtr + 1
        ReDim Preserve myFiles(1 To fCtr)
        myFiles(fCtr) = myFile
        myFile = Dir()
    Loop

    If fCtr > 0 Then
        Set wks = Workbooks.Add(1).Worksheets(1)
        wks.Range("a1").Resize(1, 3).Value _
            = Array("Property Address", "Total Value", "FileName")
            
        For fCtr = LBound(myFiles) To UBound(myFiles)
            Call DoTheWork(myPath & myFiles(fCtr), wks)
        Next fCtr
        
        wks.UsedRange.Columns.AutoFit
    End If
    
End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)

    Dim myNumber As Long
    Dim myLine As String
    Dim FileNum As Long
    Dim oRow As Long
    Dim FoundAddr As Boolean
    Dim FoundTot As Boolean
    Dim Str1 As String
    Dim Str2 As String
    
    Str1 = LCase("Property Address:")
    Str2 = LCase("Total Value:")
        
    With wks
        oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With

    FoundAddr = False
    FoundTot = False
    
    FileNum = FreeFile
    Close FileNum
    Open myFileName For Input As FileNum
    wks.Cells(oRow, "C").Value = myFileName
    Do While Not EOF(FileNum)
        Line Input #FileNum, myLine
        If LCase(Left(myLine, Len(Str1))) = Str1 Then
            wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(Str1) + 1))
            FoundAddr = True
        ElseIf LCase(Left(myLine, Len(Str2))) = Str2 Then
            wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(Str2) + 1))
            FoundTot = True
            Exit Do 'no need to contine reading the file
        End If
    Loop
    
    If FoundAddr = False Then
        wks.Cells(oRow, "A").Value = "**Error**"
    End If
    If FoundTot = False Then
        wks.Cells(oRow, "B").Value = "**Error**"
    End If
        
    Close FileNum
    
End Sub


===
But I did depend on the order of the input not changing--address comes before
total.


Willie T wrote:
> 
> Ok, I have a Routine that will read a user defined folder via an
> InputBox and get a list of all the files in that folder.
> 
> Next I pass that info to a Routine that Reads the Full Text files into
> individual Excel spreadsheets, so I've made some progress.
> 
> My problems left to resolve:
> 1.      I want to read into one single spreadsheet not 25 (i.e. 25 text
> files into a single spreadsheet)
> 2.      I want 1 header line in the one spreadsheet
> 3.      I want only select info out of each text file not the entire text
> file.
> 
> Can I read the 11th line in each of the text file and import ONLY the
> text behind the semicolon?
> For example, the 11th line in each file is as follows:
> Property Address:209 MAIN ST
> I only want to import "209 MAIN ST" from the 11th line in each text
> file and place the first entry in A2 of the Excel Spreadsheet, then
> read the next file and place that Property Address in Cell A3 until all
> text files are read.
> 
> Can anyone help or direct me to a group that can.
> 
> Code is listed below.  Keep in mind that since the code is snippets, it
> still need some clean up.
> 
> Thanks in advance.
> 
> Willie T
> 
> Dim MyFileSystemObject As Object 'fs
> Dim MyFolderObject As Object 'f
> Dim MyFileObject As Object 'f1
> Dim MyFileCollection As Object 'fc
> Sub LoopThroughInputFiles()
> Dim RoutineStartSecondCount As Long
> Dim ThisFileFinishSecondCount As Long
> Dim AverageSecondsPerFile As Long
> Dim StringToDebugPrint As String
> 
> RoutineStartSecondCount = Int(Timer) 'int of seconds elapsed since
> midnight
> 
> FolderContainingRawFiles = InputBox("Enter Name, c/w Path, of Folder
> Containing Raw Files")
> 
> FileCounter = 0 'initialise
> 
> 'Dim MyFileSystemObject As Object 'fs
> 'Dim MyFolderObject As Object 'f
> 'Dim MyFileObject As Object 'f1
> 'Dim MyFileCollection As Object 'fc
> 
> Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject")
> 'MyFileSystemObject is a filesystemobject
> Set MyFolderObject =
> MyFileSystemObject.GetFolder(FolderContainingRawFiles)  'MyFolderObject
> is the folder object
> 
> Set MyFileCollection = MyFolderObject.Files 'fc is the collection of
> file objects in folder object f
> 
> For Each MyFileObject In MyFileCollection
> FileToWorkWith = MyFileObject.Name
> 'Now call function/sub to work with file...
> 'FunctionToOpenAndWorkWithFile
> ReadFullTextFile
> 
> FileCounter = FileCounter + 1
> ThisFileFinishSecondCount = Int(Timer)
> AverageSecondsPerFile = (ThisFileFinishSecondCount -
> RoutineStartSecondCount) / FileCounter
> StringToDebugPrint = FileCounter & " files (of about "
> StringToDebugPrint = StringToDebugPrint &
> MyFileCollection.Count
> StringToDebugPrint = StringToDebugPrint & ") done so far;
> time remaining "
> StringToDebugPrint = StringToDebugPrint &
> Format((AverageSecondsPerFile * (MyFileCollection.Count - FileCounter)
> / 60), "0.0")
> StringToDebugPrint = StringToDebugPrint & " minutes"
> StringToDebugPrint = StringToDebugPrint & " (average " &
> Int(AverageSecondsPerFile)
> StringToDebugPrint = StringToDebugPrint & " seconds/file)"
> Debug.Print StringToDebugPrint
> 
> Next
> Debug.Print "File Addition Finished (at last!) " & Date & ", " &
> Time
> End Sub
> 
> Sub ReadFullTextFile()
> 
> Dim oExcel As Object
> Dim oBook As Object
> Dim osheet As Object
> 
> Dim filename As String
> 
> Set oExcel = CreateObject("Excel.Application")
> 
> ' Open text file
> 'filename = "c:\MAIN-ST-205.txt"
> 'Set oBook = oExcel.Workbooks.Open(filename)
> Set oBook = oExcel.Workbooks.Open(MyFileObject)
> Set oBook = oExcel.ActiveWorkbook
> 
> oBook.Sheets(1).Activate
> Set osheet = oBook.Sheets(1)
> 
> 'Set osheet = oBook.ActiveSheet
> ' Make Excel visible
> oExcel.Visible = True
> oExcel.UserControl = True
> 
> ' save as excel workbook
> 'filename2 = "c:\MAIN-ST-205.xls"
> filename2 = (MyFileObject) & ".xls"
> oBook.SaveAs filename2, 1
> 
> ' ***** At this point I would like to run a macro, however they are
> 'not available in the macro window or within this code.
> Set oExcel = Nothing
> Set oBook = Nothing
> 
> 'End
> End Sub

-- 

Dave Peterson
0
ec357201 (5290)
1/5/2005 11:59:59 PM
Dave,

Thanks a million.  It is a colon, my bad.  Your code makes more sence
and runs fine, but I'm returning **Error** in both cases.  Again, I new
to VBA and programming but i can step thru your code, see how it work,
and follow it fairly well.  Below is a sample of one of the text files
that I running your code against.  It the 14th line down for Str1 and
the 34th line down for Str2.  Can you help?  Thanks again for your help
in advance.

Report on Parcel xx-xx-2-000-022.000 00Courthouse Retrieval System -
Jefferson
County, AL
Report on Parcel :xx-xx-2-000-022.000 00Generated :1/4/2005


General Information

LastName FirstName MidNane
FirstName MidNane
xxxx CHERRY AVE
BIRMINGHAM , AL  35214Parcel ID:xx-xx-2-000-022.000 00
Alt-Parcel ID:152420002200
Subdivision
Property Address:205 MAIN ST
BIRMINGHAM, AL 35213-2914
Telephone:()-
Special Int:
Map Sort::
Plat Book:0000
Subdv Block:
Parcel:0
SSD1:000
Ward:05
Land C Map:
Acct No:
Page:0000
Lot:
District:05
SSD2:


Land Value:2900
Improvement Value:5200
Total Value:8100
                  Assessed Value:1620

0
google3775 (11)
1/6/2005 3:55:30 PM
I pasted your sample data into a text file and saved it.

I got this out:

Property Address  Total Value  FileName
**Error**         **Error**    c:\my documents\excel\README.TXT
205 MAIN ST       8100         c:\my documents\excel\Edit3.txt
**Error**         **Error**    c:\my documents\excel\test.txt
**Error**         **Error**    c:\my documents\excel\spacedelim.txt


Just guesses.  

You did change the folder name:
myPath = "c:\my documents\excel"

Do you have any lines with leading spaces?

If yes, you could clean them up in your favorite text editor (yech!) or just do
it in code:

    Do While Not EOF(FileNum)
        Line Input #FileNum, myLine
        If LCase(Left(Trim(myLine), Len(Str1))) = Str1 Then      '<---
            wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(Str1) + 1))
            FoundAddr = True
        ElseIf LCase(Left(Trim(myLine), Len(Str2))) = Str2 Then  '<---
            wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(Str2) + 1))
            FoundTot = True
            Exit Do 'no need to contine reading the file
        End If
    Loop

(notice the addition of Trim() in 2 spots.)

(I'm guessing that there's something else in that text file that's difficult to
see/notice.)




Willie T wrote:
> 
> Dave,
> 
> Thanks a million.  It is a colon, my bad.  Your code makes more sence
> and runs fine, but I'm returning **Error** in both cases.  Again, I new
> to VBA and programming but i can step thru your code, see how it work,
> and follow it fairly well.  Below is a sample of one of the text files
> that I running your code against.  It the 14th line down for Str1 and
> the 34th line down for Str2.  Can you help?  Thanks again for your help
> in advance.
> 
> Report on Parcel xx-xx-2-000-022.000 00Courthouse Retrieval System -
> Jefferson
> County, AL
> Report on Parcel :xx-xx-2-000-022.000 00Generated :1/4/2005
> 
> General Information
> 
> LastName FirstName MidNane
> FirstName MidNane
> xxxx CHERRY AVE
> BIRMINGHAM , AL  35214Parcel ID:xx-xx-2-000-022.000 00
> Alt-Parcel ID:152420002200
> Subdivision
> Property Address:205 MAIN ST
> BIRMINGHAM, AL 35213-2914
> Telephone:()-
> Special Int:
> Map Sort::
> Plat Book:0000
> Subdv Block:
> Parcel:0
> SSD1:000
> Ward:05
> Land C Map:
> Acct No:
> Page:0000
> Lot:
> District:05
> SSD2:
> 
> Land Value:2900
> Improvement Value:5200
> Total Value:8100
>                   Assessed Value:1620

-- 

Dave Peterson
0
ec357201 (5290)
1/7/2005 12:05:22 AM
Dave,

I know the problem, but not the solution...

The leading spaces are causing me a problem in the text files.  I also
took out the Lower Case option; although, I'm not sure if that was part
of my problem or not.  As you can see below, I padded Str1 with the
leading spaces and it worked fine, but Str2 still returned **Error**.


'Str1 = LCase("Property Address:")
'Str2 = LCase("Total Value:")

Str1 = ("                  Property Address:")
Str2 = ("Total Value:")

Also note in my Do While Loop I also took out the LCase option.

Do While Not EOF(FileNum)
Line Input #FileNum, myLine
'If LCase(Left(myLine, Len(Str1))) = Str1 Then
If Left(myLine, Len(Str1)) = Str1 Then
wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(Str1) +
1))
FoundAddr = True
'ElseIf LCase(Left(myLine, Len(Str2))) = Str2 Then
ElseIf (Left(myLine, Len(Str2))) = Str2 Then
wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(Str2) +
1))
FoundTot = True
Exit Do 'no need to contine reading the file
End If
Loop

Is there a way to strip out or not consider the leading blank spaces.

Thanks again for your help.  This application is going to cut my old
manual processing time down from about 5 days to less than 1 day.
Thanks

Willie T

0
google3775 (11)
1/7/2005 12:15:54 AM
We crossed in the ether.

See my other post (if you haven't already).

(I'd put back the lcase() stuff.  Just seems a little safer to me--or less to do
when you get a file that's been manually edited.)

Willie T wrote:
> 
> Dave,
> 
> I know the problem, but not the solution...
> 
> The leading spaces are causing me a problem in the text files.  I also
> took out the Lower Case option; although, I'm not sure if that was part
> of my problem or not.  As you can see below, I padded Str1 with the
> leading spaces and it worked fine, but Str2 still returned **Error**.
> 
> 'Str1 = LCase("Property Address:")
> 'Str2 = LCase("Total Value:")
> 
> Str1 = ("                  Property Address:")
> Str2 = ("Total Value:")
> 
> Also note in my Do While Loop I also took out the LCase option.
> 
> Do While Not EOF(FileNum)
> Line Input #FileNum, myLine
> 'If LCase(Left(myLine, Len(Str1))) = Str1 Then
> If Left(myLine, Len(Str1)) = Str1 Then
> wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(Str1) +
> 1))
> FoundAddr = True
> 'ElseIf LCase(Left(myLine, Len(Str2))) = Str2 Then
> ElseIf (Left(myLine, Len(Str2))) = Str2 Then
> wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(Str2) +
> 1))
> FoundTot = True
> Exit Do 'no need to contine reading the file
> End If
> Loop
> 
> Is there a way to strip out or not consider the leading blank spaces.
> 
> Thanks again for your help.  This application is going to cut my old
> manual processing time down from about 5 days to less than 1 day.
> Thanks
> 
> Willie T

-- 

Dave Peterson
0
ec357201 (5290)
1/7/2005 1:02:17 AM
Dude,

I'm slow close now.  I've added alot including some input boxes that
will be used later on in the application.  It is picking up the
property address and the Total Value but not the other items that i
have added.  Below is my code and the results:

Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim defaultproject As String
Dim ProjectName As String

'Key in your Project Name
defaultproject = "2005 Brookside Property - ALL"
ProjectName = InputBox("Enter Project Name", "Project Name:",
defaultproject)

'Key in your City or Town
city = "Brookside"
CityName = InputBox("Enter City or Town Name", "City or Town
Name:", city)

'change to point at the folder to check
'myPath = "c:\test"
myPath = "\\Hpoffice\my documents\Projects\HMGP\Brookside\2005
Brookside Project Application\CRS Full Reports"
myPath = InputBox("Enter Path of Folder Containing Text Files",
"Text Files Folder:", myPath)


If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.txt")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
fCtr = fCtr + 1
ReDim Preserve myFiles(1 To fCtr)
myFiles(fCtr) = myFile
myFile = Dir()
Loop

If fCtr > 0 Then
'Set wks = Workbooks.Add(1).Worksheets(1)
Set wks = Workbooks.Add(1).Worksheets(1)

'        wks.Range("a1").Resize(1, 3).Value _
'           = Array("Property Address", "City", "FileName")
wks.Range("a1").Resize(1, 6).Value _
= Array("Property Address", "City", "Land Value", "Imp
Value", "Tot Value", "FileName")

For fCtr = LBound(myFiles) To UBound(myFiles)
Call DoTheWork(myPath & myFiles(fCtr), wks)
Next fCtr

wks.UsedRange.Columns.AutoFit
End If

End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)

Dim myNumber As Long
Dim myLine As String
Dim FileNum As Long
Dim oRow As Long

Dim FoundAddr As Boolean
Dim FoundCity As Boolean
Dim FoundLandValue As Boolean
Dim FoundImpValue As Boolean
Dim FoundTotValue As Boolean

Dim StrAddr As String
Dim StrCity As String
Dim StrLandValue As String
Dim StrImpValue As String
Dim StrTotValue As String

'StrAddr = LCase("                  Property Address:")
StrAddr = LCase("Property Address:")
StrCity = LCase("| TAX DISTRICT:") 'City
StrLandValue = LCase("Land Value:") 'Land Value
StrImpValue = LCase("Improvement Value:") 'Structures Value
StrTotValue = LCase("Total Value:") 'Land Value + Structures Value

With wks
oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

FoundAddr = False
FoundCity = False
FoundLandValue = False
FoundImpValue = False
FoundTotValue = False

FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
'   wks.Cells(oRow, "C").Value = myFileName
wks.Cells(oRow, "F").Value = myFileName

Do While Not EOF(FileNum)
Line Input #FileNum, myLine
'If LCase(Left(myLine, Len(Str1))) = Str1 Then
If LCase(Left(Trim(myLine), Len(StrAddr))) = StrAddr Then
wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(StrAddr) +
1))
FoundAddr = True
ElseIf LCase(Left(Trim(myLine), Len(StrCity))) = StrCity Then
wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(StrCity) +
1))
FoundCity = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrLandValue))) =
StrLandValue Then
wks.Cells(oRow, "C").Value = Trim(Mid(myLine,
Len(StrLandValue) + 1))
FoundLandValue = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrImpValue))) =
StrImpValue Then
wks.Cells(oRow, "D").Value = Trim(Mid(myLine,
Len(StrImpValue) + 1))
FoundImpValue = True
Exit Do 'no need to contine reading the file
ElseIf LCase(Left(Trim(myLine), Len(StrTotValue))) =
StrTotValue Then
wks.Cells(oRow, "E").Value = Trim(Mid(myLine,
Len(StrTotValue) + 1))
FoundTotValue = True
Exit Do 'no need to contine reading the file
End If
Loop

If FoundAddr = False Then
wks.Cells(oRow, "A").Value = "**Error**"
End If
If FoundCity = False Then
wks.Cells(oRow, "B").Value = "**Error**"
End If
If FoundLandValue = False Then
wks.Cells(oRow, "C").Value = "**Error**"
End If
If FoundImpValue = False Then
wks.Cells(oRow, "D").Value = "**Error**"
End If
If FoundTotValue = False Then
wks.Cells(oRow, "E").Value = "**Error**"
End If

Close FileNum

End Sub


Results:
Property Address	City	Land Value	Imp Value	Tot Value
Property Address:264 BIVENS BROOKSID RD	**Error**	Land
Value:4400	**Error**	**Error**
Property Address:292 BIVENS BROOKSID RD	**Error**	Land
Value:14000	**Error**	**Error**
Property Address:204 CARDIFF ST	**Error**	Land
Value:12600	**Error**	**Error**
Property Address:324 CARDIFF ST	**Error**	Land
Value:7100	**Error**	**Error**
Property Address:445 CARDIFF ST	**Error**	Land
Value:9200	**Error**	**Error**
Property Address:428 GRAHAM DR	**Error**	Land
Value:14200	**Error**	**Error**
Property Address:110 MAIN ST	**Error**	Land
Value:5300	**Error**	**Error**
Property Address:200 MAIN ST	**Error**	Land
Value:6700	**Error**	**Error**
Property Address:201 MAIN ST	**Error**	Land
Value:3900	**Error**	**Error**
Property Address:205 MAIN ST	**Error**	Land
Value:2900	**Error**	**Error**
Property Address:209 MAIN ST	**Error**	Land
Value:1500	**Error**	**Error**
Property Address:117 MARKET ST	**Error**	Land
Value:7600	**Error**	**Error**
Property Address:141 MARKET ST	**Error**	Land
Value:6800	**Error**	**Error**
Property Address:207 MARKET ST	**Error**	Land
Value:5400	**Error**	**Error**
Property Address:140 MIMOSA ST	**Error**	Land
Value:17000	**Error**	**Error**
Property Address:111 PRICE ST	**Error**	Land
Value:3100	**Error**	**Error**
Property Address:132 PRICE ST	**Error**	Land
Value:3900	**Error**	**Error**
Property Address:136 PRICE ST	**Error**	Land
Value:3500	**Error**	**Error**
Property Address:140 PRICE ST	**Error**	Land
Value:2600	**Error**	**Error**
Property Address:144 PRICE ST	**Error**	Land
Value:3500	**Error**	**Error**
Property Address:145 PRICE ST	**Error**	Land
Value:3700	**Error**	**Error**
Property Address:216 PRICE ST	**Error**	Land
Value:4500	**Error**	**Error**
Property Address:220 PRICE ST	**Error**	Land
Value:6100	**Error**	**Error**
Property Address:119 VALLEY DR	**Error**	Land
Value:16100	**Error**	**Error**
Property Address:130 VALLEY DR	**Error**	Land
Value:13200	**Error**	**Error**
Property Address:154 VALLEY DR	**Error**	Land
Value:11900	**Error**	**Error**


Here is a sample text file:

Report on Parcel 15-24-2-000-021.000 00Courthouse Retrieval System -
Jefferson
County, AL
Report on Parcel :15-24-2-000-021.000 00Generated :1/4/2005


General Information

SPRUELL THERON C

1756 CHERRY AVE
BIRMINGHAM , AL  35214Parcel ID:15-24-2-000-021.000 00
Alt-Parcel ID:152420002100
Subdivision
Property Address:201 MAIN ST
BIRMINGHAM, AL 35213-2914
Telephone:()-
Special Int:
Map Sort::
Plat Book:0000
Subdv Block:
Parcel:0
SSD1:000
Ward:05
Land C Map:
Acct No:
Page:0000
Lot:
District:05
SSD2:


Land Value:3900
Improvement Value:0
Total Value:3900
Assessed Value:780
City Tax:
County Tax:
Total Tax:
Last Sale Date:
Last Sale Amount:0
Book/Page:/
Document No:
Exemption Amount:0
Exemption Reason:
Dimensions:36S X 415S IRR
Acreage:0.33
Square Feet:
Geo Code:-86.755083 : 33.506186
Census Tract:108.01
Census Block:1
Gas Source:PUBLIC
Electric Source:PUBLIC
Water Source:PUBLIC
Sewer Source:INDIVIDUAL
Description:P O B 290 FT S N OF N E INTER OF MAIN ST
& PRICE
ST TH N 36 FT S ALG MAIN ST TH E 300 FT D 350 FT S TO
CENTER
LINE OF 5 | TAX DISTRICT: BROOKSIDE
Property Type:COMMERCIAL
Land Use:910 VACANT AND UNUSED LAND
Improvement Type:
Zoning Code:I3
Owner Type:
Road Type:PAVED
Topography:LEVEL
District Trend:


Land Data For Parcel
Land TypeLand SizeLand AmountLand Use
REG. LOT: SQFT144053850910


Building Information - No Building Data Available for Parcel:
15-24-2-000-021.000 00



Extra Features - No Extra Feature Data Available for Parcel:
15-24-2-000-021.000
00



Sales & Deed History


Sales DataDeed Data
No Sales Data Available for Parcel...
Owner:Book:1446Date:04/13/77
Page:0943




Trust Deed Information - No Trust Deed Data Available for Parcel:
15-24-2-000-021.000 00
Information Deemed Reliable, but Not Guaranteed

0
google3775 (11)
1/7/2005 2:49:06 AM
There were a bunch of "exit do"'s that said to leave the loop as soon as that
record was found.

If you know that one of those keys is always last, you can exit after you find
that.  It should make processing a little faster--but with small files, it
probably won't be noticeable.

And instead of using several boolean values, I just prepopulated the row with
**Error**'s.  Then the real data will overwrite it if found.  (makes it a little
simpler.  (I didn't think of it until I logged off yesterday.)

Option Explicit
Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim defaultproject As String
Dim ProjectName As String
Dim City As String
Dim CityName As String

'Key in your Project Name
defaultproject = "2005 Brookside Property - ALL"
ProjectName = InputBox("Enter Project Name", "Project Name:", defaultproject)

'Key in your City or Town
City = "Brookside"
CityName = InputBox("Enter City or Town Name", "City or Town Name:", City)

'change to point at the folder to check
'myPath = "c:\test"
myPath = "\\Hpoffice\my documents\Projects\HMGP\Brookside\" & _ 
              "2005 Brookside Project Application\CRS Full Reports"
myPath = InputBox("Enter Path of Folder Containing Text Files", _
           "Text Files Folder:", myPath)


If Right(myPath, 1) <> "\" Then
    myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.txt")
If myFile = "" Then
    MsgBox "no files found"
    Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
    fCtr = fCtr + 1
    ReDim Preserve myFiles(1 To fCtr)
    myFiles(fCtr) = myFile
    myFile = Dir()
Loop

If fCtr > 0 Then
    Set wks = Workbooks.Add(1).Worksheets(1)
    wks.Range("a1").Resize(1, 6).Value _
        = Array("Property Address", "City", "Land Value", "Imp Value", _
                    "Tot Value", "FileName")

For fCtr = LBound(myFiles) To UBound(myFiles)
    Call DoTheWork(myPath & myFiles(fCtr), wks)
Next fCtr

wks.UsedRange.Columns.AutoFit
End If

End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)

Dim myNumber As Long
Dim myLine As String
Dim FileNum As Long
Dim oRow As Long

Dim StrAddr As String
Dim StrCity As String
Dim StrLandValue As String
Dim StrImpValue As String
Dim StrTotValue As String

StrAddr = LCase("Property Address:")
StrCity = LCase("| TAX DISTRICT:") 'City
StrLandValue = LCase("Land Value:") 'Land Value
StrImpValue = LCase("Improvement Value:") 'Structures Value
StrTotValue = LCase("Total Value:") 'Land Value + Structures Value

With wks
    oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

wks.Cells(oRow, "A").Resize(1, 5).Value = "**Error**"

FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
wks.Cells(oRow, "F").Value = myFileName

Do While Not EOF(FileNum)
    Line Input #FileNum, myLine    
    If LCase(Left(Trim(myLine), Len(StrAddr))) = StrAddr Then
        wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(StrAddr) + 1))
    ElseIf LCase(Left(Trim(myLine), Len(StrCity))) = StrCity Then
        wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(StrCity) + 1))
        Exit Do  '<---only one get out now in any of these tests!
    ElseIf LCase(Left(Trim(myLine), Len(StrLandValue))) = StrLandValue Then
        wks.Cells(oRow, "C").Value = Trim(Mid(myLine, Len(StrLandValue) + 1))
    ElseIf LCase(Left(Trim(myLine), Len(StrImpValue))) = StrImpValue Then
        wks.Cells(oRow, "D").Value = Trim(Mid(myLine, Len(StrImpValue) + 1))
    ElseIf LCase(Left(Trim(myLine), Len(StrTotValue))) = StrTotValue Then
        wks.Cells(oRow, "E").Value = Trim(Mid(myLine, Len(StrTotValue) + 1))
    End If
Loop

Close FileNum

End Sub

===
As an aside, to get the folder,

If you're using xl2002+, you can read about:
Application.FileDialog
in VBA's help.

If before, then Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

Or John Walkenbach's:
http://j-walk.com/ss/excel/tips/tip29.htm





Willie T wrote:
> 
> Dude,
> 
> I'm slow close now.  I've added alot including some input boxes that
> will be used later on in the application.  It is picking up the
> property address and the Total Value but not the other items that i
> have added.  Below is my code and the results:
> 
> Sub testme()
> 
> Dim myFiles() As String
> Dim fCtr As Long
> Dim myFile As String
> Dim myPath As String
> Dim wkbk As Workbook
> Dim wks As Worksheet
> Dim defaultproject As String
> Dim ProjectName As String
> 
> 'Key in your Project Name
> defaultproject = "2005 Brookside Property - ALL"
> ProjectName = InputBox("Enter Project Name", "Project Name:",
> defaultproject)
> 
> 'Key in your City or Town
> city = "Brookside"
> CityName = InputBox("Enter City or Town Name", "City or Town
> Name:", city)
> 
> 'change to point at the folder to check
> 'myPath = "c:\test"
> myPath = "\\Hpoffice\my documents\Projects\HMGP\Brookside\2005
> Brookside Project Application\CRS Full Reports"
> myPath = InputBox("Enter Path of Folder Containing Text Files",
> "Text Files Folder:", myPath)
> 
> If Right(myPath, 1) <> "\" Then
> myPath = myPath & "\"
> End If
> 
> myFile = Dir(myPath & "*.txt")
> If myFile = "" Then
> MsgBox "no files found"
> Exit Sub
> End If
> 
> 'get the list of files
> fCtr = 0
> Do While myFile <> ""
> fCtr = fCtr + 1
> ReDim Preserve myFiles(1 To fCtr)
> myFiles(fCtr) = myFile
> myFile = Dir()
> Loop
> 
> If fCtr > 0 Then
> 'Set wks = Workbooks.Add(1).Worksheets(1)
> Set wks = Workbooks.Add(1).Worksheets(1)
> 
> '        wks.Range("a1").Resize(1, 3).Value _
> '           = Array("Property Address", "City", "FileName")
> wks.Range("a1").Resize(1, 6).Value _
> = Array("Property Address", "City", "Land Value", "Imp
> Value", "Tot Value", "FileName")
> 
> For fCtr = LBound(myFiles) To UBound(myFiles)
> Call DoTheWork(myPath & myFiles(fCtr), wks)
> Next fCtr
> 
> wks.UsedRange.Columns.AutoFit
> End If
> 
> End Sub
> Sub DoTheWork(myFileName As String, wks As Worksheet)
> 
> Dim myNumber As Long
> Dim myLine As String
> Dim FileNum As Long
> Dim oRow As Long
> 
> Dim FoundAddr As Boolean
> Dim FoundCity As Boolean
> Dim FoundLandValue As Boolean
> Dim FoundImpValue As Boolean
> Dim FoundTotValue As Boolean
> 
> Dim StrAddr As String
> Dim StrCity As String
> Dim StrLandValue As String
> Dim StrImpValue As String
> Dim StrTotValue As String
> 
> 'StrAddr = LCase("                  Property Address:")
> StrAddr = LCase("Property Address:")
> StrCity = LCase("| TAX DISTRICT:") 'City
> StrLandValue = LCase("Land Value:") 'Land Value
> StrImpValue = LCase("Improvement Value:") 'Structures Value
> StrTotValue = LCase("Total Value:") 'Land Value + Structures Value
> 
> With wks
> oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
> End With
> 
> FoundAddr = False
> FoundCity = False
> FoundLandValue = False
> FoundImpValue = False
> FoundTotValue = False
> 
> FileNum = FreeFile
> Close FileNum
> Open myFileName For Input As FileNum
> '   wks.Cells(oRow, "C").Value = myFileName
> wks.Cells(oRow, "F").Value = myFileName
> 
> Do While Not EOF(FileNum)
> Line Input #FileNum, myLine
> 'If LCase(Left(myLine, Len(Str1))) = Str1 Then
> If LCase(Left(Trim(myLine), Len(StrAddr))) = StrAddr Then
> wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(StrAddr) +
> 1))
> FoundAddr = True
> ElseIf LCase(Left(Trim(myLine), Len(StrCity))) = StrCity Then
> wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(StrCity) +
> 1))
> FoundCity = True
> Exit Do 'no need to contine reading the file
> ElseIf LCase(Left(Trim(myLine), Len(StrLandValue))) =
> StrLandValue Then
> wks.Cells(oRow, "C").Value = Trim(Mid(myLine,
> Len(StrLandValue) + 1))
> FoundLandValue = True
> Exit Do 'no need to contine reading the file
> ElseIf LCase(Left(Trim(myLine), Len(StrImpValue))) =
> StrImpValue Then
> wks.Cells(oRow, "D").Value = Trim(Mid(myLine,
> Len(StrImpValue) + 1))
> FoundImpValue = True
> Exit Do 'no need to contine reading the file
> ElseIf LCase(Left(Trim(myLine), Len(StrTotValue))) =
> StrTotValue Then
> wks.Cells(oRow, "E").Value = Trim(Mid(myLine,
> Len(StrTotValue) + 1))
> FoundTotValue = True
> Exit Do 'no need to contine reading the file
> End If
> Loop
> 
> If FoundAddr = False Then
> wks.Cells(oRow, "A").Value = "**Error**"
> End If
> If FoundCity = False Then
> wks.Cells(oRow, "B").Value = "**Error**"
> End If
> If FoundLandValue = False Then
> wks.Cells(oRow, "C").Value = "**Error**"
> End If
> If FoundImpValue = False Then
> wks.Cells(oRow, "D").Value = "**Error**"
> End If
> If FoundTotValue = False Then
> wks.Cells(oRow, "E").Value = "**Error**"
> End If
> 
> Close FileNum
> 
> End Sub
> 
> Results:
> Property Address        City    Land Value      Imp Value       Tot Value
> Property Address:264 BIVENS BROOKSID RD **Error**       Land
> Value:4400      **Error**       **Error**
> Property Address:292 BIVENS BROOKSID RD **Error**       Land
> Value:14000     **Error**       **Error**
> Property Address:204 CARDIFF ST **Error**       Land
> Value:12600     **Error**       **Error**
> Property Address:324 CARDIFF ST **Error**       Land
> Value:7100      **Error**       **Error**
> Property Address:445 CARDIFF ST **Error**       Land
> Value:9200      **Error**       **Error**
> Property Address:428 GRAHAM DR  **Error**       Land
> Value:14200     **Error**       **Error**
> Property Address:110 MAIN ST    **Error**       Land
> Value:5300      **Error**       **Error**
> Property Address:200 MAIN ST    **Error**       Land
> Value:6700      **Error**       **Error**
> Property Address:201 MAIN ST    **Error**       Land
> Value:3900      **Error**       **Error**
> Property Address:205 MAIN ST    **Error**       Land
> Value:2900      **Error**       **Error**
> Property Address:209 MAIN ST    **Error**       Land
> Value:1500      **Error**       **Error**
> Property Address:117 MARKET ST  **Error**       Land
> Value:7600      **Error**       **Error**
> Property Address:141 MARKET ST  **Error**       Land
> Value:6800      **Error**       **Error**
> Property Address:207 MARKET ST  **Error**       Land
> Value:5400      **Error**       **Error**
> Property Address:140 MIMOSA ST  **Error**       Land
> Value:17000     **Error**       **Error**
> Property Address:111 PRICE ST   **Error**       Land
> Value:3100      **Error**       **Error**
> Property Address:132 PRICE ST   **Error**       Land
> Value:3900      **Error**       **Error**
> Property Address:136 PRICE ST   **Error**       Land
> Value:3500      **Error**       **Error**
> Property Address:140 PRICE ST   **Error**       Land
> Value:2600      **Error**       **Error**
> Property Address:144 PRICE ST   **Error**       Land
> Value:3500      **Error**       **Error**
> Property Address:145 PRICE ST   **Error**       Land
> Value:3700      **Error**       **Error**
> Property Address:216 PRICE ST   **Error**       Land
> Value:4500      **Error**       **Error**
> Property Address:220 PRICE ST   **Error**       Land
> Value:6100      **Error**       **Error**
> Property Address:119 VALLEY DR  **Error**       Land
> Value:16100     **Error**       **Error**
> Property Address:130 VALLEY DR  **Error**       Land
> Value:13200     **Error**       **Error**
> Property Address:154 VALLEY DR  **Error**       Land
> Value:11900     **Error**       **Error**
> 
> Here is a sample text file:
> 
> Report on Parcel 15-24-2-000-021.000 00Courthouse Retrieval System -
> Jefferson
> County, AL
> Report on Parcel :15-24-2-000-021.000 00Generated :1/4/2005
> 
> General Information
> 
> SPRUELL THERON C
> 
> 1756 CHERRY AVE
> BIRMINGHAM , AL  35214Parcel ID:15-24-2-000-021.000 00
> Alt-Parcel ID:152420002100
> Subdivision
> Property Address:201 MAIN ST
> BIRMINGHAM, AL 35213-2914
> Telephone:()-
> Special Int:
> Map Sort::
> Plat Book:0000
> Subdv Block:
> Parcel:0
> SSD1:000
> Ward:05
> Land C Map:
> Acct No:
> Page:0000
> Lot:
> District:05
> SSD2:
> 
> Land Value:3900
> Improvement Value:0
> Total Value:3900
> Assessed Value:780
> City Tax:
> County Tax:
> Total Tax:
> Last Sale Date:
> Last Sale Amount:0
> Book/Page:/
> Document No:
> Exemption Amount:0
> Exemption Reason:
> Dimensions:36S X 415S IRR
> Acreage:0.33
> Square Feet:
> Geo Code:-86.755083 : 33.506186
> Census Tract:108.01
> Census Block:1
> Gas Source:PUBLIC
> Electric Source:PUBLIC
> Water Source:PUBLIC
> Sewer Source:INDIVIDUAL
> Description:P O B 290 FT S N OF N E INTER OF MAIN ST
> & PRICE
> ST TH N 36 FT S ALG MAIN ST TH E 300 FT D 350 FT S TO
> CENTER
> LINE OF 5 | TAX DISTRICT: BROOKSIDE
> Property Type:COMMERCIAL
> Land Use:910 VACANT AND UNUSED LAND
> Improvement Type:
> Zoning Code:I3
> Owner Type:
> Road Type:PAVED
> Topography:LEVEL
> District Trend:
> 
> Land Data For Parcel
> Land TypeLand SizeLand AmountLand Use
> REG. LOT: SQFT144053850910
> 
> Building Information - No Building Data Available for Parcel:
> 15-24-2-000-021.000 00
> 
> Extra Features - No Extra Feature Data Available for Parcel:
> 15-24-2-000-021.000
> 00
> 
> Sales & Deed History
> 
> Sales DataDeed Data
> No Sales Data Available for Parcel...
> Owner:Book:1446Date:04/13/77
> Page:0943
> 
> Trust Deed Information - No Trust Deed Data Available for Parcel:
> 15-24-2-000-021.000 00
> Information Deemed Reliable, but Not Guaranteed

-- 

Dave Peterson
0
ec357201 (5290)
1/7/2005 3:31:49 AM
I see you have another thread going elsewhere.

I'll bow out.

<<snipped>>
0
ec357201 (5290)
1/7/2005 3:47:29 AM
Yes, like i said i'm new to programming and these groups also so i
posted my question to several groups.  One other thread gave me some
ideals but that was bring the data into a sheet and doing the work
there.  I like your aproach better in that it gathers the information
from the text file and simply writes it to a sheet.  Must better
approach i think.

Thanks again for all your help and i'll try your suggestion from above
tomorrow when i get back to work.

Thanks again.

Willie T

0
google3775 (11)
1/7/2005 5:11:06 AM
Help with TRIM Function

I was wondering if you could help me with a TRIM Function listed below.


All work well except for the output of PID listed below.

The string it the text file is as follows:
Report on Parcel :15-24-2-000-022.000 00Generated :1/4/2005
Note that there are 7 leading blank spaces

StrPID = LCase("Report on Parcel :") '(7 Leading Blank Char)

Therefore; then output is as follows (please see code below):
15-24-2-000-022.000 00Generated :1/4/2005

where the desired output would be as follows:

15-24-2-000-022.000 00

can I Trim a line in 2 places to output the desired results.

Dave, thanks for all your help in the past.

Thanks for any help in advance

Willie T

Code Listed:
Do While Not EOF(FileNum)
Line Input #FileNum, myLine
If LCase(Left(Trim(myLine), Len(StrPID))) = StrPID Then
wks.Cells(oRow, "A").Value = Trim(Mid(myLine, Len(StrPID) +
7))
FoundPID = True
ElseIf LCase(Left(Trim(myLine), Len(StrAddr))) = StrAddr Then
wks.Cells(oRow, "B").Value = Trim(Mid(myLine, Len(StrAddr) +
19))
FoundAddr = True
ElseIf LCase(Left(Trim(myLine), Len(StrCity))) = StrCity Then
wks.Cells(oRow, "C").Value = Trim(Mid(myLine, Len(StrCity) +
1))
FoundCity = True
ElseIf LCase(Left(Trim(myLine), Len(StrLandValue))) =
StrLandValue Then
wks.Cells(oRow, "D").Value = Trim(Mid(myLine,
Len(StrLandValue) + 19))
FoundLandValue = True
ElseIf LCase(Left(Trim(myLine), Len(StrImpValue))) =
StrImpValue Then
wks.Cells(oRow, "E").Value = Trim(Mid(myLine,
Len(StrImpValue) + 19))
FoundImpValue = True
ElseIf LCase(Left(Trim(myLine), Len(StrTotValue))) =
StrTotValue Then
wks.Cells(oRow, "F").Value = Trim(Mid(myLine,
Len(StrTotValue) + 19))
FoundTotValue = True
Exit Do 'no need to contine reading the file
End If
   Loop

0
google3775 (11)
1/7/2005 8:21:20 PM
Sometimes when the project changes in midstream (one of my pals in the IT
department calls it scope-creep), the original thought turns out difficult to
keep up to date.

I've had second/third thoughts about my approach.

First, instead of using lots of times (and I wasn't trimming what I really
wanted, anyway!), just use trim once when the input line is retrieved.  (That'll
make the code easier to read.)

Second when you get lots of values to check, it's sometimes easier to set up an
array and loop through that array until you find it.  So instead of lots of
if/then/elseif's, you have something a little easier to follow.

But no my bad news.  I'm gonna assume that there's only one Special case
(getting rid of Generated) from that report input line. 

A bad habit that you shouldn't pick up--it's usually easier at the beginning to
copy|paste code than to rethink your idea and make it easier to fix/modify
later.  (But copy|paste is just so darn simple!)

Anyway, here's my latest version.  It replaces the other versions in total.

Option Explicit
Option Base 0
Dim myStrings As Variant
Dim TotalExpectedValues As Long

Sub testme()

Dim myFiles() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String
Dim wkbk As Workbook
Dim wks As Worksheet
Dim defaultproject As String
Dim ProjectName As String
Dim City As String
Dim CityName As String

'Key in your Project Name
defaultproject = "2005 Brookside Property - ALL"
ProjectName = InputBox("Enter Project Name", "Project Name:", defaultproject)

'Key in your City or Town
City = "Brookside"
CityName = InputBox("Enter City or Town Name", "City or Town Name:", City)

'change to point at the folder to check
myPath = "\\Hpoffice\my documents\Projects\HMGP\Brookside\" & _
              "2005 Brookside Project Application\CRS Full Reports"
              
'myPath = "c:\my documents\excel"
myPath = InputBox("Enter Path of Folder Containing Text Files", _
           "Text Files Folder:", myPath)


If Right(myPath, 1) <> "\" Then
    myPath = myPath & "\"
End If

'just in case the path isn't correct.
On Error Resume Next
myFile = Dir(myPath & "*.txt")
On Error GoTo 0

If myFile = "" Then
    MsgBox "no files found"
    Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile <> ""
    fCtr = fCtr + 1
    ReDim Preserve myFiles(1 To fCtr)
    myFiles(fCtr) = myFile
    myFile = Dir()
Loop

If fCtr > 0 Then
    'some housekeeping
    myStrings = Array(LCase("Property Address:"), _
                      LCase("| TAX DISTRICT:"), _
                      LCase("Land Value:"), _
                      LCase("Improvement Value:"), _
                      LCase("Total Value:"), _
                      LCase("Report on Parcel :"))
                  
    TotalExpectedValues = UBound(myStrings) - LBound(myStrings) + 1

    Set wks = Workbooks.Add(1).Worksheets(1)
    wks.Range("a1").Resize(1, TotalExpectedValues + 1).Value _
        = Array("Property Address", _
                "City", _
                "Land Value", _
                "Imp Value", _
                "Tot Value", _
                "Parcel", _
                "FileName")

    For fCtr = LBound(myFiles) To UBound(myFiles)
        Call DoTheWork(myPath & myFiles(fCtr), wks)
    Next fCtr
    
    wks.UsedRange.Columns.AutoFit
End If

End Sub
Sub DoTheWork(myFileName As String, wks As Worksheet)

Dim myNumber As Long
Dim myLine As String
Dim FileNum As Long
Dim oRow As Long

Dim FoundValues As Long
Dim SpecialKey As String
Dim SpecialStr As String
Dim SpecialPos As Long
Dim iCtr As Long

SpecialKey = LCase("Report on Parcel :")
SpecialStr = "Generated"

With wks
    oRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With

wks.Cells(oRow, "A").Resize(1, TotalExpectedValues).Value = "**Error**"

FileNum = FreeFile
Close FileNum
Open myFileName For Input As FileNum
wks.Cells(oRow, TotalExpectedValues + 1).Value = myFileName
FoundValues = 0

Do While Not EOF(FileNum)
    Line Input #FileNum, myLine
    myLine = Trim(myLine) 'get rid of all leading/trailing spaces
    For iCtr = LBound(myStrings) To UBound(myStrings)
        If LCase(Left(myLine, Len(myStrings(iCtr)))) = myStrings(iCtr) Then
            FoundValues = FoundValues + 1
            'special handling for "Report on Parcel :"
            If myStrings(iCtr) = SpecialKey Then
                SpecialPos = InStr(1, myLine, SpecialStr, vbTextCompare)
                If SpecialPos > 0 Then
                    myLine = Left(myLine, SpecialPos - 1)
                End If
            End If
            wks.Cells(oRow, "A").Offset(0, iCtr).Value _
                = Mid(myLine, Len(myStrings(iCtr)) + 1)
        End If
        If FoundValues = TotalExpectedValues Then
            Exit For
        End If
    Next iCtr
Loop

Close FileNum

End Sub

=======================
Things you may want to change:

    myStrings = Array(LCase("Property Address:"), _
                      LCase("| TAX DISTRICT:"), _
                      LCase("Land Value:"), _
                      LCase("Improvement Value:"), _
                      LCase("Total Value:"), _
                      LCase("Report on Parcel :"))
                  
and

    wks.Range("a1").Resize(1, TotalExpectedValues + 1).Value _
        = Array("Property Address", _
                "City", _
                "Land Value", _
                "Imp Value", _
                "Tot Value", _
                "Parcel", _
                "FileName")

The order you define "mystrings" is the also the order of the output (left to
right).

If you add more values to retrieve, remember to change the line that does the
headers.

And one more warning.  If you have values that look like dates:  3-5 (for
example), but are really just hyphenated text, you'll see that excel will see
that as a date when you put it in the worksheet.

If you ever decide that you want to treat everything as text (probably not!):

            wks.Cells(oRow, "A").Offset(0, iCtr).Value _
                = Mid(myLine, Len(myStrings(iCtr)) + 1)

would become:

            wks.Cells(oRow, "A").Offset(0, iCtr).Value _
                = "'" & Mid(myLine, Len(myStrings(iCtr)) + 1)

But that would screw up any numeric entries--so I bet this won't apply.

========

There's nothing really wrong with posting to multiple newsgroups if you do it
with one message--include all newsgroup names in the header.  Then anyone
reading the post in newsgroup A will see the response from Newsgroup B.  This is
called cross posting.

If you had limited your posts to the microsoft.public.* newsgroups, then you
probably wouldn't need to crosspost at all.  Most of the regulars read the high
traffic groups.

But if you send separate messages to multiple newsgroups, you could waste the
time of potential responders.  If you had already gotten a reply that you liked,
then any further posts wouldn't have been necessary.

And from a selfish point of view, you may miss a good idea.  You won't get a
thread from several people where each improves on the previous post.  (And you
have to check each newsgroup for possible responses.)

========



Willie T wrote:
<snipped>>
0
ec357201 (5290)
1/7/2005 11:29:51 PM
Typo correction (just to make it readable)

First, instead of using lots of TRIMs...

 
> First, instead of using lots of times (and I wasn't trimming what I really
> wanted, anyway!), just use trim once when the input line is retrieved.  (That'll
> make the code easier to read.)
> 

<snipped>
0
ec357201 (5290)
1/8/2005 12:37:22 AM
Reply:

Similar Artilces:

PST file locaion under Win7
Hi, Where does outlook 2007 keeps PST files under windows7? Apparently under Users/myname there is no folder AppData\Local... Thank you for your help. ...

Reading SQL Server Extended Properties
I have an Access 2003 front-end (mdb/mde) connected to a SQL Server 2000 back-end. SQL Server 2000 offers the ability to add extended properties (such as a caption, for example) to objects (tables, columns, etc.) using a stored procedure called sp_AddExtendedProperty, along with the ability to retrieve the values of these extended properties via a function named fn_ListExtendedProperty. With fn_ListExtendedProperty, four columns can be returned/selected using a Select statement: objtype, objname, name and value. The first three columns returned are of datatype sysname, whil...

Linking files 2 ways
I have a work book that is linked to another and vise versa. As thus: Workbook A is where the input of data is made; Workbook B has a link to the input from workbook A; Workbook A retrieves the altered data back as a link. Although this all works fine with both books open, I note that if I open workbook A by itself, that the data it retrieves from Workbook B is not updated . If However, both books are open, there's no problem. I thought linked books were updated automatically if the Update remote references has been selected?? But it appears that the second book is not updated until it ...

OL2007 not move big files from outbox to sent
Hi, We have 2 computers with separate email accounts on Roadrunner. One machine has XP with Outlook 2002-sp3 and works without any problems. The other has Outlook 2007 on Vista and has problems sending files over a meg or so in size. It seems to actually send the file but the file remains in the outbox folder and does not move it to the sent folder. I say it "seems" to send the file because some people complain of getting muliple copies and others don't seem to get them at all. If I hit send again (not set up for auto send) it seems to send the file again (why some ...

Using Relative path for XML data file?
Is there a way to specify a relative path to an XML data file imported into Excel 2003? I am writing a web app that generates report data as XML for the user to download to their local machine. This data is to be consumed by an Excel reporting spreadsheet, which contains display-formatted tables and charts that are mapped to various data fields in an XML Map, which is in turn linked to the xml data file they will download. The idea is the user only needs to download the data for updates, not the whole spreadsheet. However, since I cannot predict the path where the user will store their...

How to repair a .dll file in IE8
Several days ago I noticed in my Dependency Walker that the IESHIMS.dll files has a yellow circle with a question mark on it. What does this mean and How do I repair it? OS: Windows Vista Home Premium Browser Internet Explorer 8 -- TW Hi, See the History tab on that dialog. A web search for ieshims.dll files will also help you find a solution for that file. Regards. "TW" <TW@discussions.microsoft.com> wrote in message news:63E61463-D766-4ABC-B081-BFA8C04FB159@microsoft.com... > Several days ago I noticed in my Dependency Walker that the IESHIMS....

Excel button problem
Hi All I have a macro that copies a worksheet in the active workbook and puts it into a new workbook - then formats it and deletes any buttons on the worksheet. On the first click on the button the macro works ok. On the second click, it fails because the all assigned macros on all buttons in the active workbook changed from "mba" to "book1!mba". Book 1 doesn't exists (wasn't opened, wasn't saved, doesn't have the macros). I've never experienced this problem before?? Can anyone help to solve this problem? FYI The macro to do this is c...

Excel 97 #9
Please can anyone help??? I have two columns in Excel 97. The first contains a list of statu values eg. pending, or granted or withdrawn. The second contains date eg.01/12/1997, 05/06/2003. I woudl like to know how to get all th granted apps before 31/12/2003. Can anyone help please -- Message posted from http://www.ExcelForum.com theres many ways, but an easiest way would be to do a sort. Highlight the 2 columns, click on data, then sort, then sort by status, then by date. this should group them all together. hope this helps...toe >-----Original Message----- >Please can anyo...

New to excel
Hi All, I'm new to Excel ( and to this forum :) ) and so I hope somebody may b able to help me. I've got 2 questions.... QUESTION 1 I've got a spreadsheet which takes data from one worksheet and uses i to calculate data in a second worksheet using the following code formula: =IF('4th November 2005'!B19="","nothing here dude",IF(B19<'4th Novembe 2005'!B19,"UP",IF(B19='4th November 2005'!B19,"Same",IF(B19>'4t November 2005'!B19,"DOWN")))) The problem is, when I create a new worksheet I have...

Looking for Excel Help
I'm a very novice Excel user and am looking for a little help with creating a formula for a spreadsheet I'm creating for my personal use. I would appreciate some assistance if possible. Thanks in advance. Dan --- Message posted from http://www.ExcelForum.com/ Hi Dan! Post a sample of what you want to do. Your question is just a tad open ended <g> -- Regards Norman Harker MVP (Excel) Sydney, Australia njharker@optusnet.com.au Excel and Word Function Lists (Classifications, Syntax and Arguments) available free to good homes. "DanB4105" <DanB4105.ywtpa@excelfor...

Maximum file sizes
Is there a recommended maximum file size for Excel 2000. PC spec 2Ghz P4 with 256 Mb Any advice appreciated Deus -------------- Does Not Exist Hi have a look at http://www.decisionmodels.com/memlimits.htm -- Regards Frank Kabel Frankfurt, Germany "Deus DNE" <deus.dne@ntlworld.com> schrieb im Newsbeitrag news:1561701c41d4f$358950f0$a001280a@phx.gbl... > Is there a recommended maximum file size for Excel 2000. > > PC spec 2Ghz P4 with 256 Mb > > Any advice appreciated > > Deus > -------------- > Does Not Exist ...

unsolicited entry in the folder "Temporary Internet Files"
Hello, I am working on a programme which browses web sites and runs under XP. The http download is as follows: pServer = Isession -> GetHttpConnection(strServerName, nPort); pFile = pServer->OpenRequest(CHttpConnection::HTTP_VERB_GET, strObject, NULL, 1, NULL, NULL, dwHttpRequestFlags); pFile->SendRequest(); pFile->QueryInfoStatusCode(dwStatusCode); if(dwStatusCode == 200) { pFile -> QueryInfo(HTTP_QUERY_LAST_MODIFIED, &sysT); status.lastMod = sysT; if(DBlastMod == status.lastMod) //URL content has not changed since the last visit ...

File size #11
I have read the other discussions on file sizes but they do not seem to address my problem. I have an Excel file that is 12mb large with low-res jpegs in it. This file also has merged cells to make it look pretty. Does Excel look at these merged cells as graphics? Is this why they are too big? I have run a macro to make sure that it goes to the last cell. How can I get the file smaller? How big are the graphics? If you remove them from the file, what is the size of the file and what is the size of the graphic files? To be sure you do not have extra formatting, if you open the file...

how to convert lookup values to the "display text"
I'm using an sql code (below) which uses a few lookup fields. Unfortunately in the datasheet view, I get the "bound values" instead of the "display values". How can I change the properties for the these lookup fields so I can see the "display values" from the datasheet view? SELECT [Funding],[Date],[Description],[Company],[Expense_Type],[Amount],[Status] FROM [Form_9_Status] UNION ALL SELECT [Funding],[Date],[Description],[Company],[Expense_Type],[Amount],[Status] FROM [TDY_Status] UNION ALL SELECT [Funding],[Date],[Description],[C...

find action on log file
Hello there I want to use outside tool to find who made some update on table in my server I know that there are many tools for this. But can they do it on simple recovery model? Roy Goldhammer (royg@yahoo.com) writes: > I want to use outside tool to find who made some update on table in my > server > > I know that there are many tools for this. But can they do it on simple > recovery model? No. If you are using the simple recovery model, the contents of the log is wasted away everyonce in a while. Well, if the disk area has not been overwritten...

Formula without using numbers after decimal in the answer
I have a formula that derives the answer from a figure with a decimal. I don't want to use the figures after the decimal. Is there a way to just use the whole number and omit the numbers after the decimal without having to manually key in all these numbers manually? Thanks, Mustang You can use the INT function. This 'rounds down' any number to th nearest integer, e.g. if A1=2.567, a formula in B2 of =INT(A1) return 2 HTH Bruc -- swatsp0 ----------------------------------------------------------------------- swatsp0p's Profile: http://www.excelforum.com/member.php?...

using the journal on outlook
Once I link an email to the journal, can I still find that email in my mail box? I seem to be able to get to it only via the journal. If this is the way it is supposed to be, how do I remove it from the journal and get it back into my mail box? Am I just missing something? -- thanks, Independent Are you linking to the item or putting a copy into the journal item? Also, has the item been archived or not? "Independent" <Independent@discussions.microsoft.com> wrote in message news:868279F2-53C8-403A-97F5-604CEECD873C@microsoft.com... > Once I link an email to the journ...

Excel corrupts when asking to update vlookups
We are experiencing weird behavior with some Office 2K3 Excel spreadsheets that contain lots of calculations, but no macros. On some pc’s Excel acts normally, on others you get the error. I have a couple of screen shots available. Any help is appreciated. If desired, send your file to my address below. I will only look if: 1. You send a copy of this message on an inserted sheet 2. You give me the newsgroup and the subject line 3. You send a clear explanation of what you want 4. You send before/after examples and expected results. -- Don Gu...

Uninstall of mappoint has caused errors with excel
Hi, I am running Office 2003 on the terminal server (windows 2003) and had a copy of mappoint as well. This is a mapping program. We ininstalled mappoint which has caused an error message with Excel and other office products. The error says "Cd:\documents and settings\administrator.ocrdc1\application data\microsoft\addins c:\Program files\common files\microsoft shared\geography\mpoai9.dll is not a valid add-in." I then click OK and excel opens up and everything is fine. The problem is that we are using other programs as well such as Quickbooks that export to excel and t...

CSV Files and VLOOKUP error
Does anyone know why VLOOKUP and Compare formulas don't work o information originating from a CSV file? I've tried copying an pasting values only (to leave behind any formatting), but it doesn' help. Through countless tests, I've narrowed it down to the CSV file bein the only possible cause -- Message posted from http://www.ExcelForum.com Hi ajpowers, Just a guess but the imported data may have leading or trailing spaces or are numbers stored as text. You could use the formula =A1=D1 to see if you get a true or false, where A1 is the lookup value and D1 ia the CVS valu...

How do I overlay text to a row without loosing the text in the ba.
I would like to know how to give an entire row (or column) a text overlay such as "VOID" and still be able to view the text in the underlaying row (or column). Thanks in advance. Use WordArt from the Drawing toolbar. Change the Fill to None. -- Jim Rech Excel MVP "Bruce Charles" <Bruce Charles@discussions.microsoft.com> wrote in message news:C430F6BC-1EBD-461F-A3FA-EC8592C5704C@microsoft.com... |I would like to know how to give an entire row (or column) a text overlay | such as "VOID" and still be able to view the text in the underlaying row (or | c...

How do I Remove a Split from my Comments in Excel 2003? #2
I have set my current workbook to split/freeze the first column and first 2 rows. Now, when I add a comment to the second row (in any column) my comments are cut off if I should scroll down. I don't ever remember the behavior before. And I don't know what I've done to enable it but it's really annoying. How do turn this off ? ...

How to automate increasing the form cache registry/file etc...
I want to roll out a batch file to make a number of tweaks to CRM The body of it would go REGEDIT /S Kerberosefix.reg REGEDIT /S ForceFormreload.reg REGEDIT /S OutlookFix.reg It would also rename OSA.exe to OSA.bad Remove OSA.exe From the startup menu I need help finding a way to use my batch file to increase the Outlook Form cache from the default 4MB to 50 MB.. This makes CRm more stable and faster for communications. I dont want to manually do this, as it time consuming, are my end users would not be reliable in doing it themselves. I also want to make another batch file or button that...

learning Excel #3
Hi, I was considering learning Excel as an additional tool for my data analysis work. Is it better to use data sets that I have previously used with SPSS and apply the same analysis tools as in SPSS? For applying the appropriate tools, I was considering using excel's online help. The second option I have is to use some excel book for data analysis and apply the techniques to data sets provided with the book. Any suggestions????? regards Metal ...

unable to paste Excel 2003 chart into Outlook 2003
(This was posted on "excel.charting" group.) I have a user who's unable to paste an Excel 2003 chart into Outlook 2003 email message. In Outlook options, the checkbox is selected for "Use Microsoft Office Word 2003 to edit e-mail messages". When I tested this on my own computer running the same version of Office, if the box is check, I have no problem pasting; if this box is cleared, I cannot paste. But on his computer, it doesn't work regardless. Thanks and regards, TL ...