ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Verify selection of cells (https://www.excelbanter.com/excel-programming/399759-verify-selection-cells.html)

chemtyra

Verify selection of cells
 
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

JE McGimpsey

Verify selection of cells
 
One way:

If Selection.Cells.Count < 5 Then
MsgBox "You must select 5 cells"
Exit Sub
End If

In article ,
chemtyra wrote:

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


Gary''s Student

Verify selection of cells
 
Sub seltest()
If Selection.Count < 5 Then
Exit Sub
End If
MsgBox ("five items selected")
End Sub
--
Gary''s Student - gsnu200750


"chemtyra" wrote:

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



All times are GMT +1. The time now is 05:24 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com