C
chemtyra
Hello,
I have a macro that runs a calculation on five cells. The user selects a
range of five cells. I want to verify the user has actually selected five
cells before running the calculation.
Here is my code thus far.
Public Sub MeasurementsAnalyze()
On Error GoTo Err_MeasurementsAnalyze
Dim myRange As Range
Dim myRow As Integer
Dim myColumn As Integer
Dim myDifference As Double
Dim myArrayPosition As Integer
Set myRange = Selection
myRow = myRange.Row
myColumn = myRange.Column
myColumnLetter = Mid(myRange.Address, 2, ((InStr(2, myRange.Address,
"$") - InStr(1, myRange.Address, "$")) - 1))
'MsgBox "Row: " & myRow & ", Column: " & myColumn & ", ColumnLetter: " &
myColumnLetter
myRange.Interior.ColorIndex = xlNone
i = Array(1, 1, 2, 1, 1, 2, 3, 1, 2, 1)
j = Array(2, 3, 3, 2, 4, 4, 4, 3, 3, 2)
k = Array(3, 4, 4, 4, 5, 5, 5, 5, 5, 5)
myDifference = 1 'Default to any number greater than .1
myArrayPosition = -1 'Default to any number not on the array
For l = 0 To 9
v1 = Range(myColumnLetter & (i(l) + (myRow - 1))).Value
v2 = Range(myColumnLetter & (j(l) + (myRow - 1))).Value
v3 = Range(myColumnLetter & (k(l) + (myRow - 1))).Value
d1 = Abs(v1 - v2)
d2 = Abs(v1 - v3)
d3 = Abs(v2 - v3)
'If l = 2 Then Stop
m = Application.WorksheetFunction.Max(d1, d2, d3)
If m < myDifference Then
myDifference = m
myArrayPosition = l
End If
Next l
'We may want this to be <= ?
If myDifference < 0.1 Then
Cells((i(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
Cells((j(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
Cells((k(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
End If
Exit_MeasurementsAnalyze:
Set myRange = Nothing
Exit Sub
Err_MeasurementsAnalyze:
MsgBox Err.Description
Err.Clear
Resume Exit_MeasurementsAnalyze
End Sub
Thank you for your help
Tyra
I have a macro that runs a calculation on five cells. The user selects a
range of five cells. I want to verify the user has actually selected five
cells before running the calculation.
Here is my code thus far.
Public Sub MeasurementsAnalyze()
On Error GoTo Err_MeasurementsAnalyze
Dim myRange As Range
Dim myRow As Integer
Dim myColumn As Integer
Dim myDifference As Double
Dim myArrayPosition As Integer
Set myRange = Selection
myRow = myRange.Row
myColumn = myRange.Column
myColumnLetter = Mid(myRange.Address, 2, ((InStr(2, myRange.Address,
"$") - InStr(1, myRange.Address, "$")) - 1))
'MsgBox "Row: " & myRow & ", Column: " & myColumn & ", ColumnLetter: " &
myColumnLetter
myRange.Interior.ColorIndex = xlNone
i = Array(1, 1, 2, 1, 1, 2, 3, 1, 2, 1)
j = Array(2, 3, 3, 2, 4, 4, 4, 3, 3, 2)
k = Array(3, 4, 4, 4, 5, 5, 5, 5, 5, 5)
myDifference = 1 'Default to any number greater than .1
myArrayPosition = -1 'Default to any number not on the array
For l = 0 To 9
v1 = Range(myColumnLetter & (i(l) + (myRow - 1))).Value
v2 = Range(myColumnLetter & (j(l) + (myRow - 1))).Value
v3 = Range(myColumnLetter & (k(l) + (myRow - 1))).Value
d1 = Abs(v1 - v2)
d2 = Abs(v1 - v3)
d3 = Abs(v2 - v3)
'If l = 2 Then Stop
m = Application.WorksheetFunction.Max(d1, d2, d3)
If m < myDifference Then
myDifference = m
myArrayPosition = l
End If
Next l
'We may want this to be <= ?
If myDifference < 0.1 Then
Cells((i(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
Cells((j(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
Cells((k(myArrayPosition) + (myRow - 1)),
myColumn).Interior.ColorIndex = 4
End If
Exit_MeasurementsAnalyze:
Set myRange = Nothing
Exit Sub
Err_MeasurementsAnalyze:
MsgBox Err.Description
Err.Clear
Resume Exit_MeasurementsAnalyze
End Sub
Thank you for your help
Tyra