Crrection Help for a macro to locate max value cell

[twinklejmj]

Hi,

I got a macro to locate the cell containing maximum value in a range
Then it goes to another cell in the same row to copy the text there an
paste it another cell. But it is not working. In debugging mode it goe
to the bold line in the code. Can someone please help??

Here is the code:

Private Sub CommandButton3_Click()

Dim i As Integer
Dim sCells As String
Dim rng As Range

Set rng = Range("L26:L38")
For i = 26 To 38
If Application.CountIf(rng, Cells(i, "L")) > 1 Then
…….
……

Call FindMax
End Sub

The macro Findmax is given below:

Sub FindMax()
Dim rng1 As Excel.Range
Set rng1 = Range("L26:L38")
*Range("L:L").Find(Excel.WorksheetFunction.Max(rng1)).Select * (Here i
stops!!)

ActiveCell.Offset(0, -10).Select
Selection.Copy
Range("B83").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Su

 

[Bob Phillips]

I have no idea what this means

If Application.CountIf(rng, Cells(i, "L")) > 1 Then
…….
……

I had to comment it out to run it, and then everything ran okay..

 

[twinklejmj]

Hi Bob,
Thanks a lot. I give the full macro below. It may be difficult to
comment that part as I need it. Please see whether you can help me
further.

Private Sub CommandButton3_Click()

Dim i As Integer
Dim sCells As String
Dim rng As Range

Set rng = Range("L26:L38")
For i = 26 To 38
If Application.CountIf(rng, Cells(i, "L")) > 1 Then
sCells = sCells & Cells(i, "L").Address(False, False) & ","
sCells = Left(sCells, Len(sCells) - 1)
MsgBox "Please go back and assign UNIQUE rank to each cause. You have
assigned same rank to different causes"
Exit Sub
End If
Next i
Columns("L:L").Select
Range("L26:L38").Select

Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlFormulas,
LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate


ActiveCell.Offset(0, -10).Select
Selection.Copy
Range("B45").Select
ActiveSheet.Paste
Application.CutCopyMode = False


Call FindMax
End Sub

-----------

Sub FindMax()
Dim rng1 As Excel.Range
Set rng1 = Range("L26:L38")
Range("L:L").Find(Excel.WorksheetFunction.Max(rng1)).Select
ActiveCell.Offset(0, -10).Select
Selection.Copy
Range("B83").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


I hope it will be clearer now. I lookforward to a great solution.

Thanks.

Twinkle