PDA

View Full Version : Solved: should work but doesn't - application.inputbox problem?



chrisweirman
03-05-2009, 01:27 PM
Hi,
I've had some help with coding a maximum finder and it works well. I've modified it so that the values it looks
for contain a minimum threshold, using an input box if it needs to be changed.

The input method works fine but the if c.value > threshold_value in the code below returns values that are <0.1
(for instance) but still meet the second if statement (with the offsets). This should be an easy fix but I can't get
my head around it.

Sub findmax_working()
Dim c As Range
Dim i As Long
Dim shtcnt As Long
Dim column As Integer
column = -4
Dim threshold_value As Long
threshold_value = 0.1
If msgbox("Residuals threshold value set to 0.1. Do you want to change this?", vbYesNo _
+ vbDefaultButton2, "Threshold Value OK?") = vbYes Then
threshold_value = Application.InputBox("Please input new threshold value", "Threshold Value _
Input", 0.1, , , , , 1)
Else: End If
For Each s In ActiveWorkbook.Sheets
s.Activate
If s.Name <> "residuals" Then
i = 10
For Each c In Worksheets(s.Name).Range("b6:at91")
If c.Value > threshold_value Then
If c.Value > c.Offset(-1, -1).Value And c.Value > c.Offset(-1, 0).Value And c.Value > c.Offset _
(-1, 1).Value And c.Value > c.Offset(0, -1).Value And c.Value > c.Offset(0, 1).Value And c.Value _
> c.Offset(1, -1).Value And c.Value > c.Offset(1, 0).Value And c.Value >= c.Offset(1, 1).Value Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Worksheets("residuals").Cells(i, column) = "Scan " & ActiveSheet.Name
Worksheets("residuals").Cells(i, column + 1) = "Anode " & i - 9
Worksheets("residuals").Cells(i, column + 2) = c.Value
Worksheets("residuals").Cells(i, column + 3).Formula = "=address(" & c.row & "," & c.column & ")"
i = i + 1
End If
End If
Next c
End If
column = column + 5
Next s
Worksheets("residuals").Activate
End Sub

Sub findmax_not_working()
Dim c As Range
Dim i As Long
Dim shtcnt As Long
Dim column As Integer
column = -4
Dim threshold_value As Long
threshold_value = 0.1
'If msgbox("Residuals threshold value set to 0.1. Do you want to change this?", _
vbYesNo + vbDefaultButton2, "Threshold Value OK?") = vbYes Then
'threshold_value = Application.InputBox("Please input new threshold value", _
"Threshold Value Input", 0.1, , , , , 1) 'Else:
End If
For Each s In ActiveWorkbook.Sheets
s.Activate
If s.Name <> "residuals" Then
i = 10
For Each c In Worksheets(s.Name).Range("b6:at91")
If c.Value > 0.1 Then
If c.Value > c.Offset(-1, -1).Value And c.Value > c.Offset(-1, 0).Value And c.Value > c.Offset _
(-1, 1).Value And c.Value > c.Offset(0, -1).Value And c.Value > c.Offset(0, 1).Value And _
c.Value > c.Offset(1, -1).Value And c.Value > c.Offset(1, 0).Value And c.Value >= c.Offset _
(1, 1).Value Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Worksheets("residuals").Cells(i, column) = "Scan " & ActiveSheet.Name
Worksheets("residuals").Cells(i, column + 1) = "Anode " & i - 9
Worksheets("residuals").Cells(i, column + 2) = c.Value
Worksheets("residuals").Cells(i, column + 3).Formula = "=address(" & c.row & "," & c.column & ")"
i = i + 1
End If
End If
Next c
End If
column = column + 5
Next s
Worksheets("residuals").Activate
End Sub
Anybody?:dunno

chrisweirman
03-05-2009, 01:27 PM
actually it's the wrong way around - the top sub doesn't work, the bottom one does.

Bob Phillips
03-06-2009, 02:16 AM
So, is it solved or not?

chrisweirman
03-06-2009, 06:47 AM
Umm, no. My currrent code for this (inlcuding a file opening step is);

Sub import_files_into_workbook()
'
' import_file_into_workbook Macro
'
Dim myfile As String
Dim mypath As String
Dim this_file As String
Dim target_file As String
Dim f As Integer
Dim scan_data As Variant
this_file = ActiveSheet.Name
mypath = ActiveWorkbook.Path & "\"
For f = 1 To 25
If f <= 10 Then
myfile = "text;" & mypath & this_file & "00" & (f - 1) & "calib.grd"
target_file = this_file & "00" & (f - 1) & "calib"
End If
If f > 10 Then
myfile = "text;" & mypath & this_file & "0" & (f - 1) & "calib.grd"
target_file = this_file & "0" & (f - 1) & "calib"
End If
'
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
myfile _
, Destination:=Range("$B$1"))
.Name = target_file
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets.Select
Sheets(f).Move After:=Sheets(f + 1)
'Columns("b:b").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Name = target_file
'select range of cells
'If f = 1 Then
'Set scan_data = Application.InputBox("Please select cell range", "Cell Range Selection", "B6:AT91", , , , , 8)
'last_cell = Range.Find(8, "b6")
'End If
Next f
Dim c As Range
Dim i As Long
Dim shtcnt As Long
Dim column As Integer
Dim s As Variant
column = 0
Dim threshold_value As Long
If MsgBox("Residuals threshold value set to 0.1. Do you want to change this?", vbYesNo _
+ vbDefaultButton2, "Threshold Value OK?") = vbYes Then
threshold_value = Application.InputBox("Please input new threshold value", "Threshold Value _
Input", 0.1, , , , , 1)
Else: threshold_value = 0.1
End If
For Each s In ActiveWorkbook.Sheets
s.Activate
'If column = 1 Then
' scan_data = Application.InputBox("Please select cell range", "Cell Range Selection", "B6:AT91", , , , , 8)
'End If
If s.Name <> this_file Then
i = 10
Worksheets(this_file).Cells(i, column + 2) = ActiveSheet.Name
i = i + 1
For Each c In Worksheets(s.Name).Range("b6:bz200")
If c.Value > threshold_value And c.Value > c.Offset(-1, -1).Value And c.Value > c.Offset(-1, 0).Value _
And c.Value > c.Offset(-1, 1).Value And c.Value > c.Offset(0, -1).Value And c.Value > c.Offset(0, 1). _
Value And c.Value > c.Offset(1, -1).Value And c.Value > c.Offset(1, 0).Value And c.Value >= c.Offset _
(1, 1).Value Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Worksheets(this_file).Cells(i, column) = ActiveSheet.Name
If column = 1 Then
Worksheets(this_file).Cells(i, column) = "Anode " & i - 9
Worksheets(this_file).Cells(i, column + 1).Formula = "=address(" & c.row & "," & c.column & ")"
Else: End If
Worksheets(this_file).Cells(i, column + 2) = c.Value
i = i + 1
Else
i = i + 1
End If
Next c
End If
column = column + 1
Next s
Worksheets(this_file).Activate
Cells.Select
Cells.EntireColumn.AutoFit
Cells.Select
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="$", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'For Each c In Worksheets(this_file).Range("a10:dt20000")
'Next c
Rows("11:6557").Select
ActiveWorkbook.Worksheets(this_file).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(this_file).Sort.SortFields.Add Key:= _
Range("A11"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets(this_file).Sort
.SetRange Range("A11:DS6557")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
What I can't get my head around is the c.value > threshold.value part. Why would this not end
the if loop is c.value < threshold_value??? When I run this and select a threshold value of say 0.2
I get result including values less than 0.2, but they still meet the specification of being the local
maximum. It doesn't make sense to me. When I put in a statement like c.value > 0.2 then it works
fine. Is there something wrong with the variable classification?

Cheers