Problem with Select Case construct?

G

Guest

Hi Folks,

I have several hundred files of X, Y, Z coordinate data that I need to
process as follows. Each file has anywhere from a few dozen to a few
hundred X & Z values for each Y value, and there are from a few dozen to a
few hundred Y values in each file. All coordinates are in centimeters.

For each value of Y=0cm (always the first values in the file), I need to
find the lowest Z value. For each subsequent non-zero Y value, I also need to
find the lowest Z value whose X value is within plus or minus 5cm of the X
value of the lowest Z value of the previous Y value. Thus, for example, if
Y=0cm and the X value of the lowest Z value is 50cm, then the lowest Z value
for Y=5 would have to have an X value in the range 45-55cm inclusive. For
each Y value, once the lowest Z value has been found both it and its X&Y
values are pasted into another worksheet entitles 'Thalweg'.

I've written a macro to do all the above (full code below) and it seems to
work most of the time. For each coordinate file, the Select_Profile procedure
first calls the FindMinZzero procedure, which is used to find the for Y=0.
Once this value has been found and the 3 coordinates pasted into the
'Thalweg' workbook, control passes back to the Select_Profile procedure. This
scrolls through the rest of the Y=0 values until it reaches the first
non-zero Y value, at which point it calls the FindMinZnonzero procedure,
which is used to find the lowest Z value as described above. Control switches
between this procedure and the Select_Profile procedure until all Y values
have been evaluated.

For each Y value, I use the Select Case constructs to evaluate the different
Z-value scenarios and they seem to work most if the time. Sometimes, though
they seem to completely defy the logic contained in the 'Case Is' expressions
and I'm at a loss to know why. For example, when the FindMinZzero procedure
works through each of the Z values below, it correctly selects the decreasing
Z values until it reaches and selects Z=52.30, but it doesn't then select
Z=52.14 immediately below it, which is the real lowest Z value. Further, once
Z=52.30 has been selected, the code incorrectly uses the 4th 'Case Is'
scenario in FindMinZzero to work through most of the remaining Z values,
instead of the 3rd 'Case Is' scenario which would be the correct one for most
of these Z values.

I have very similar problems when working through the non-zero Y values,
with the added problem that sometimes the limiting condition applied by the X
value is incorrectly evaluated. This throws of all subsequent evaluations.


X Y Z
-57.0 0.0 58.80
-57.5 0.0 56.70
-58.0 0.0 54.09
-58.5 0.0 53.95
-59.0 0.0 53.68
-59.5 0.0 53.66
-60.0 0.0 53.49
-60.5 0.0 52.96
-61.0 0.0 52.69
-61.5 0.0 52.51
-62.0 0.0 53.00
-62.5 0.0 52.70
-63.0 0.0 52.30
-63.5 0.0 52.14
-64.0 0.0 52.37
-64.5 0.0 52.16
-65.0 0.0 53.19
-65.5 0.0 53.42
-66.0 0.0 53.60
-66.5 0.0 53.82
-67.0 0.0 53.89
-67.5 0.0 54.14
-68.0 0.0 54.33
-68.5 0.0 54.63
-69.0 0.0 56.66
-69.5 0.0 57.15
-70.0 0.0 57.71
-70.5 0.0 58.28
-71.0 0.0 58.74
-71.5 0.0 58.80

As I said, I'm at a loss to know why this happens. I've stepped through the
code line by line and it seems as though sometimes the code detects the two
decimal places and sometimes it doesn't. Also, sometimes it seems to
correctly evaluate the full 'Case Is' expression and sometimes it fails
completely to do so.

Is my code incorrectly written in places to detect the two decimal places?
Or are some of the 'Case Is' expressions too long (i.e. too many conditions),
or have I written the logic incorrectly? Or is there a bug in the program?
(I'm using Excel 2003 with Windows XP Home Edition, version 5.1).

My second main problem, and one that I suspect has a simple solution, is
that I want to include the name of the file in the 'Thalweg' spreadsheet
above the 3 columns of X,Y,Z coordinates. The code as it is written
(ActiveCell.Value = "R400420.xls") does this when refering to a specific file
name as shown. However, when I tried passing 'Filename' from the
'Batch_Thalweg' procedure to the 'Select_Profile'procedure and using this in
place of a specific file name, the program errored-out. How can I get the
code to automatically insert the filenames passed by the Batching procedure?


Thanks very much for any light anyone can shed on the above!!

Cheers,

--
Chris



Option Explicit

'USThalX is a variable containing the X coordinate of the thalweg
'immediately upstream from the profile currently being
'evaluated.
Dim USThalX As Double, rgS As Range
Dim PrevVal As Double
Dim MinZ As Range
Dim LeftCell As Range, RightCell As Range
Dim Lower As Double, Upper As Double

Sub Batch_Thalweg()
'Create a list of all the files in the folder and all subfolders.

Dim fs As FileSearch
Dim i As Integer

Set fs = Application.FileSearch
With fs
.LookIn =
"C:\PhD\ElwhaRiverProject\Physical_modelling\Model_Data_Corrected\Tester3\Two"
.SearchSubFolders = True
.Filename = "*.xls"
.Execute
End With

'Pass each file in the list in turn to the Select_Profile procedure.
For i = 1 To fs.FoundFiles.Count
Call Select_Profile(fs.FoundFiles(i))
Next i
End Sub



Sub Select_Profile(Filename As String)

'Open the file passed to the procedure by the Batch-Thalweg procedure
Workbooks.Open Filename:=Filename

'Select Column B that contains the Y-coordinate data
Set rgS = Worksheets(1).Range("B2:B65536")
Application.ScreenUpdating = False
rgS.Select

'Cell B2 always contains the value 0, so the FindMinZzero procedure is
'called.
Call FindMinZzero

'Once the thalweg X, Y, Z coordinates have been pasted into the thalweg
'spreadsheet, control is passed back to the Select_Profile procedure and
'the USThalX variable is given the value of the ActiveCell in the Thalweg
'spreadsheet. The cell immediately below is selected as the new ActiveCell
'and the full surface coordinate file is reactivated. The ActiveCell
'will now be the cell in column C containing the thalweg Z coordinate.
'The Y coordinate for this point is thus selected and the Do-Until loop
'is used to scroll down to the last Y=0 value in column B.
USThalX = ActiveCell.Value

ActiveCell.Offset(1, 0).Select
Windows("R400420.xls").Activate
ActiveCell.Offset(0, -1).Select
Do Until ActiveCell.Offset(1, 0).Value > ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop

'A Do-While loop is established and the first non-zero Y coordinate /
'first Y coordinate of the next non-zero profile is selected. The
'FindMinZnonzero procedure is then called and the value of the USThalX
'variable is passed to it.
Do
ActiveCell.Offset(1, 0).Select
Call FindMinZnonzero(USThalX)
USThalX = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Windows("R400420.xls").Activate
ActiveCell.Offset(0, -1).Select
Do While ActiveCell.Offset(1, 0).Value = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Loop
Loop While Not IsEmpty(ActiveCell.Offset(1, 0))

'Once all the X,Y,Z coordinates in the file have been evaluated
'the filename and the column headings X, Y & Z are inserted at
'the top of the list of pasted coordinates in the 'Thalweg' sheet.
Windows("Thalweg.xls").Activate
ActiveCell.Offset(-1, 0).Select
ActiveCell.End(xlUp).Select
ActiveCell.Value = "R400420.xls"
ActiveCell.Offset(1, 0).Select
ActiveCell.Value = "X"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Y"
ActiveCell.Offset(0, 1).Select
ActiveCell.Value = "Z"
ActiveCell.Offset(1, -2).Select
ActiveCell.Offset(2, 4).Select
Windows("R400420.xls").Activate

ActiveWorkbook.Close SaveChanges:=False

End Sub



Sub FindMinZzero()

Application.ScreenUpdating = False
Set MinZ = ActiveCell.Offset(0, 1) 'i.e. MinZ = cell C2

'Evaluate the X and Z coordinates for each Y coordinate
Do While ActiveCell.Value = ActiveCell.Offset(1, 0).Value
Select Case ActiveCell.Offset(1, 1).Value
Case Is <= ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value <= MinZ.Value
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
Case Is > ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
Case Is <= ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
End Select
Loop

'Select the cell containing the smallest Z value that is
'within the acceptable range of X coordinate values
MinZ.Select

'Copy all contiguous cells in the row containing MinZ and
'paste them into the 'Thalweg' workskeet
Set LeftCell = Cells(ActiveCell.Row, 1)
Set RightCell = Cells(ActiveCell.Row, 256)

If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End _
(xlToRight)
If IsEmpty(RightCell) Then Set RightCell = RightCell.End _
(xlToLeft)
If LeftCell.Column = 256 And RightCell.Column = 1 Then _
ActiveCell.Select Else Range(LeftCell, RightCell).Copy

Windows("Thalweg.xls").Activate
ActiveSheet.Paste

End Sub 'Control passes back to the 'Select_Profile' procedure



Sub FindMinZnonzero(ByVal USThalXpassed)

Application.ScreenUpdating = False
Set MinZ = ActiveCell.Offset(0, 1)

'Set the range of X coordinate values from which the Z
'coordinate can be chosen
Lower = USThalXpassed - 5
Upper = USThalXpassed + 5

'Evaluate the X and Z coordinates for each Y coordinate
Do While ActiveCell.Value = ActiveCell.Offset(1, 0).Value
Select Case ActiveCell.Offset(1, 1).Value
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value = MinZ.Value And ActiveCell. _
Offset(1, -1).Value = Lower
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value = MinZ.Value And ActiveCell. _
Offset(1, -1).Value = Upper
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value = MinZ.Value And ActiveCell. _
Offset(1, -1).Value > Lower And ActiveCell. _
Offset(1, -1).Value < Upper
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is < ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value < MinZ.Value And ActiveCell. _
Offset(1, -1).Value = Lower
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is < ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value < MinZ.Value And ActiveCell. _
Offset(1, -1).Value = Upper
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is < ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value < MinZ.Value And ActiveCell. _
Offset(1, -1).Value > Lower And ActiveCell. _
Offset(1, -1).Value < Upper
Set MinZ = ActiveCell.Offset(1, 1)
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value = MinZ.Value And ActiveCell. _
Offset(1, -1).Value < Lower Or ActiveCell. _
Offset(1, -1).Value > Upper
ActiveCell.Offset(1, 0).Select
Case Is < ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value < MinZ.Value And ActiveCell. _
Offset(1, -1).Value < Lower Or ActiveCell. _
Offset(1, -1).Value > Upper
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
Case Is > ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
Case Is = ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
Case Is < ActiveCell. _
Offset(0, 1).Value And ActiveCell.Offset _
(1, 1).Value > MinZ.Value
ActiveCell.Offset(1, 0).Select
End Select
MsgBox "MinZ =" & MinZ
Loop

'Select the cell containing the smallest Z value that is
'within the acceptable range of X coordinate values
MinZ.Select

'Copy all contiguous cells in the row containing MinZ and
'paste them into the 'Thalweg' workskeet
Set LeftCell = Cells(ActiveCell.Row, 1)
Set RightCell = Cells(ActiveCell.Row, 256)

If IsEmpty(LeftCell) Then Set LeftCell = LeftCell.End _
(xlToRight)
If IsEmpty(RightCell) Then Set RightCell = RightCell.End _
(xlToLeft)
If LeftCell.Column = 256 And RightCell.Column = 1 Then _
ActiveCell.Select Else Range(LeftCell, RightCell).Copy

Windows("Thalweg.xls").Activate
ActiveSheet.Paste

End Sub 'Control passes back to the 'Select_Profile' procedure
 
G

Guest

Looks like the hard way to me. Try something like this as a first pattern:

Sub Find_Small(x As Integer, y As Integer, ySMALL As Integer)
Dim xZERO As Single, yZERO As Integer, zZERO As Single

xZERO = Cells(y, x - 1).Value
zZERO = Cells(y, x + 1).Value
yZERO = y
Do Until IsEmpty(Cells(y, x).Value) Or _
(Cells(y, x).Value <> Cells(y + 1, x).Value)
If zZERO > Cells(y, x + 1).Value Then
xZERO = Cells(y, x - 1).Value
yZERO = Cells(y, x).Value
zZERO = Cells(y, x + 1).Value
ySMALL = y
End If
y = y + 1
Loop
End Sub

Sub A_Test()
Dim x As Integer, y As Integer, SMALL As Integer
x = 7
y = 2
Find_Small x, y, SMALL
MsgBox "x= " & Cells(SMALL, x - 1).Value & ", y= " & Cells(SMALL, x).Value &
", z= " & Cells(SMALL, x + 1).Value
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Select Case 13
Can Vba workout if a selection is part of a group? 0
conflict of one loop to another? 3
Help with formula in vb coding 5
Entering data from a userform into multiple sheets 2
Combobox will not show list 4
Need help-For loop 3
Establish if Offset RANGE contains text 11

Top