View Single Post
  #13   Report Post  
Dave Peterson
 
Posts: n/a
Default

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