PDA

View Full Version : Iterating through a list of cells



aaronreyna
08-24-2009, 04:04 PM
Hello everyone, I am so new it's pitiful. With less than a week of VBA 6.5 under my belt, I have run into a wall. I have been struggling and cant seem to get past this problem.

Ok, here goes.

I have about 3000 comma delimited text files, each with a ID# and a corresponding Z unit. (about 40,000 entries in each).
example:
1,20
2,22
3,30
4,15
...

When I read it into excel, I preform a quick(not always) percentile function and end up with a minimum and maximum height for the total input. I take these two numbers and write them to a text file.

I was able to successfully do this, but when I try and preform a loop based off of a list of cells each with a path name to an individual text file (ex. C:\test\test1.txt, C:\test\test2.txt...), I end up looping through the list more than the total number of text files I read in, and the output file that is written to only lists the first text file in the loop multiple times.


Sub run_Click()

'Clear Contents
Range("A2:B100000").Select
Selection.ClearContents
Dim i As Long, nd As Long, MaxBuilding As Integer, MinBuilding As Integer, q As Long
Dim Temp(100000) As Double, Dens(100000) As Double, File_name As String

q = 1
nxtc = q + 1
Range("Q1").Select
For q = 0 To nxtc
File_name = Sheet1.Cells(1, 17).Value
'fetch data from the file
Open File_name For Input As #1
Do
If EOF(1) Then Exit Do
nd = nd + 1
Input #1, Temp(nd), Dens(nd)
Loop
Close #1
'Display values on the worksheet
Sheets("Export_Output1").Select

Range("a2").Select
For i = 0 To nd
ActiveCell.Value = Temp(i)
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = Dens(i)
ActiveCell.Offset(1, -1).Select
Next i
Range("a1").Select
'create a file
Open "c:\test_output\test_out.txt" For Append As #2
MaxBuilding = Range("h12")
MinBuilding = Range("k12")
Write #2, MaxBuilding, MinBuilding, File_name
Close #2
'clear Contents
Range("A2:B100000").Select
Selection.ClearContents
Next q
End Sub

Sub clear()
Range("A2:B100000").Select
Selection.ClearContents
End Sub

What is written in the output file is similar to:

25,17,"C:\test_output\text_in1.txt"
25,17,"C:\test_output\text_in2.txt"
25,17,"C:\test_output\text_in3.txt"

What is interesting is that in this case, i only read in 2 input files, and ended up with three identical outputs.

Any help would be greatly appreciated. thanks!

aaron

Kieran
08-24-2009, 09:39 PM
Hi,

I note 'For q = 0 To nxtc' is for the range of 0,1 and 2 as nxtc is 2 at this point. That would give 3 iterations.

I also had a try at simplifying the code and propose the follwoing untested edit.

Sub run_Click()
'Clear Contents
Range("A2:B100000").Select
Selection.ClearContents
Dim i As Long, nd As Long, MaxBuilding As Integer, MinBuilding As Integer, q As Long
Dim Temp As Double, Dens As Double, File_name As String
q = 1
nxtc = q + 1
Range("Q1").Select
For q = 0 To nxtc
File_name = Sheet1.Cells(1, 17).Value
'fetch data from the file
Open File_name For Input As #1
Do
If EOF(1) Then Exit Do
nd = nd + 1
Input #1, Temp, Dens
'Display values on the worksheet
With Sheets("Export_Output1").Range("A1")
.Offset(nd, 0).Value = Temp
.Offset(nd, 1).Value = Dens
End With
Loop
Close #1

'create a file
Open "c:\test_output\test_out.txt" For Append As #2
MaxBuilding = Sheets("Export_Output1").Range("h12") ' this will only return the value of h12 ?
MinBuilding = Sheets("Export_Output1").Range("k12") ' this will only return the value of h12 ?
Write #2, MaxBuilding, MinBuilding, File_name
Close #2
'clear Contents
Range("A2:B100000").Select
Selection.ClearContents
Next q
End Sub

aaronreyna
08-24-2009, 09:58 PM
Oh my gosh thank you so much. I realized shortly after I posted that there must have been something wrong with the "nxtc" and "q" part of the code. Thanks again! cant wait to be able to answer questions in the future!

aaron

p45cal
08-24-2009, 11:40 PM
unless the data in
Sheet1.Cells(1, 17)
changes between iterations of the for .. next loop, then the same file is being opened each time because
File_name = Sheet1.Cells(1, 17).Value
will always result in the same file name.

I'm guessing that the formulae in H12 and K12 are max and min formulae for just one of the columns. If that's the case then you probably don't need to write any data to a sheet at all, but find the max and min within the code.
The following doesn't address the looping, nor the file name remaining static, but provides a way of getting max and min values without writing anything to a sheet:Sub run_Click()
Dim i As Long, nd As Long, MaxBuilding As Long, MinBuilding As Long, q As Long
Dim Temp As Double, Dens As Double, File_name As String
q = 1
nxtc = q + 1
Range("Q1").Select
For q = 0 To nxtc
File_name = Sheet1.Cells(1, 17).Value 'this may ned fixing.
'fetch data from the file
'initialize max and min:
MaxBuilding = 0
MinBuilding = 1E+20
Open File_name For Input As #1
Do
If EOF(1) Then Exit Do
Input #1, Temp, Dens
If Dens > MaxBuilding Then MaxBuilding = Dens
If Dens < MinBuilding Then MinBuilding = Dens
Loop
Close #1
'create a file
Open "c:\test_output\test_out.txt" For Append As #2
Write #2, MaxBuilding, MinBuilding, File_name
Close #2
Next q
End Sub

aaronreyna
08-25-2009, 08:36 AM
The reason for the percentile is to eliminate anything outside of the 97th percentile. So it's a min and max withing that percentile. Nonetheless, AWESOME! I never even thought of doing a min max that way. Thank you so much!

aaron

p45cal
08-25-2009, 10:00 AM
The reason for the percentile is to eliminate anything outside of the 97th percentile. So it's a min and max withing that percentile. Nonetheless, AWESOME! I never even thought of doing a min max that way. Thank you so much!

aaron
I missed the bit about percentiles in your original post. However, it's still perfectly possible without writing anything to a sheet; I've reinstated the Dens array (and still haven't corrected for q and nxtc etc.) in the code below. I've tested as far as I can without seeing your data and the results look to be correct. (You might have to remove the = from one or both of <= and >=)Sub run_Click()
Dim i As Long, nd As Long, MaxBuilding As Long, MinBuilding As Long, q As Long
Dim Temp As Double, Dens() As Double, File_name As String
q = 1
nxtc = q + 1
Range("Q1").Select
For q = 0 To nxtc
File_name = Sheet1.Cells(1, 17).Value 'this may need fixing.
'fetch data from the file
'initialize max and min:
Open File_name For Input As #1
nd = 0
Do
If EOF(1) Then Exit Do
ReDim Preserve Dens(0 To nd)
Input #1, Temp, Dens(nd)
nd = nd + 1
Loop
Close #1
TopPercentile = Application.WorksheetFunction.Percentile(Dens, 0.97)
BottomPercentile = Application.WorksheetFunction.Percentile(Dens, 0.03)
MaxBuilding = 0: MinBuilding = 1E+20
For i = 0 To UBound(Dens)
If Dens(i) > MaxBuilding And Dens(i) <= TopPercentile Then MaxBuilding = Dens(i)
If Dens(i) < MinBuilding And Dens(i) >= BottomPercentile Then MinBuilding = Dens(i)
Next i
Erase Dens
'create a file
Open "c:\test_output\test_out.txt" For Append As #2
Write #2, MaxBuilding, MinBuilding, File_name
Close #2
Next q
End Sub