multiple Minimums in VBA

[iknowu99]

Aloha

Column A contains integers; I would like to identify the minimum/s. The identifying process adds 1 to column Z and in the same row as the minimum/s.

so far I have:
Set myRange = Worksheets("temp").Range("A1:A" & Range("A65536").End(xlUp).Row)
answer = Application.WorksheetFunction.Min(myRange)




Gracias

 

[iknowu99]

big problem: how does one prevent blank cells from the calculation?

otherwise the following code works:

LR = wsTo.Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = wsTo.Range("A2:A" & LR)

    With oRng.Offset(0, 1)
    .Formula = "=--(A2=MIN($A$2:$A$" & LR & "))"

    End With

 

[erik.van.geit]

would this do what you want ?
if not please provide an example

    .Formula = "=--(AND(A2<>"""",A2=MIN($A$2:$A$" & lr & ")))"

best regards,
Erik

 

[iknowu99]

after much testing I am convinced the latest formula works. Erik, can you please explain the formula?

Sometimes the column is rigid (all of column A's values are the same - no deviation) so there is no absolute min but it adds one to the rows. That skews data.

The project is in developing stages - my goal is to not add one but rather to add (max-min) to the mins, this would be ideal.

Here's an example of what i'm talking about:

sample.xls
	A	B	C	D
1	84
2	84
3
4	84
5	72	26
6	72	26
7	89
8	89
9	98
Sheet1

 

[erik.van.geit]

after much testing I am convinced the latest formula works. Erik, can you please explain the formula?

the formula checks two parameters using "AND"
A2 <> "" cell may not be empty
A2 = MININUM of the range (I suppose you know how the "lr" (last row) trick works ?

if both are TRUE the result is TRUE
the two "--" minus signs coerce the TRUE or FALSE into 1 or 0

can you explain again the second part

 

[erik.van.geit]

about rigid columns, perhaps this ?

Option Explicit

Sub test()
Dim LR As Long
Dim RA As String    'Range Address
Dim CDV As Long     'Count Different Values

LR = Cells(Rows.Count, "A").End(xlUp).Row
RA = Range("A2:A" & LR).Address

On Error Resume Next
'error when there is an empty cell in the range
CDV = Evaluate("=SUM((" & RA & "<>0)/COUNTIF(" & RA & "," & RA & "))")
'you could decide what to do when CDV = 0

    If CDV <> 1 Then    'if there are different values
    
        With Range("A2:A" & LR).Offset(0, 1)
        .Formula = "=--(AND(A2<>"""",A2=MIN($A$2:$A$" & LR & ")))"
        End With
        
    Else
    'what to do if the entire range has same value ?
        
    End If

End Sub

still not understood the last part ?

 

[iknowu99]

max is 98 min is 72

So add the value (98-72) for the rows where the min is found (unless it's rigid - it won't add anything)

 

[erik.van.geit]

to restrict the calculation time and for clarity, I've put the max and min in a variable
(could have done that in previous code)

Option Explicit

Sub test()
Dim LR As Long
Dim RA As String    'Range Address
Dim CDV As Long     'Count Different Values
Dim rngMin As Single
Dim rngMax As Single

LR = Cells(Rows.Count, "A").End(xlUp).Row
RA = Range("A2:A" & LR).Address

On Error Resume Next
'error when there is an empty cell in the range
CDV = Evaluate("=SUM((" & RA & "<>0)/COUNTIF(" & RA & "," & RA & "))")
'you could decide what to do when CDV = 0

rngMin = Application.Min(Range("A2:A" & LR))
rngMax = Application.Max(Range("A2:A" & LR))

    If CDV <> 1 Then    'if there are different values
    
        With Range("A2:A" & LR).Offset(0, 1)
        .Formula = "=AND(A2<>"""",A2=" & rngMin & ")*" & rngMax - rngMin
        End With
        
    Else
    'what to do if the entire range has same value ?
        
    End If

End Sub