VBA Macro Highest Value Copy

[hughhuyton]

I'm trying to do a macro which has a loop in a loop that finds the highest value in each row of a table and then copies the highest value to another part of the sheet. It successfully finds the maximum value in the first row but after that it copies the wrong value (not the highest). This is what my code looks like:

Dim HighestValue As Integer
Dim VCounter As Integer
Dim HCounter As Integer

Sub maximumvalue()
   
For HCounter = 0 To 9

Range("A1").Offset(HCounter, 0).Select
    
    HighestValue = 0
    
    For VCounter = 1 To 20 Step 1

    Range("A2").Offset(HCounter, VCounter).Select

    If Range("A2").Offset(HCounter, VCounter).Value > HighestValue Then

    HighestValue = Range("A2").Offset(HCounter, VCounter).Value

    End If

If Range("A2").Offset(HCounter, VCounter).Value = HighestValue Then

    HighestValue = Range("A2").Offset(HCounter, VCounter).Copy

    End If

If Range("A2").Offset(HCounter, VCounter).Value = HighestValue Then

Range("A20").PasteSpecial Paste:=xlPasteValues

End if

    Next VCounter

MsgBox "The highest Value is " & HighestValue

Next HCounter


End Sub

 

[hughhuyton]

Re: VBA Macro Highest Value

Hi Eric, this works great thank you! However, for some of the rows it says that there is no highest value found when there is one within the row and it isn't being found by the code.

 

[hughhuyton]

Re: VBA Macro Highest Value

I found this piece of code which works to find the highest value, except it looks at each column not each row, if I convert this to looking horizontally for the highest value I think it will work.

<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Private Sub Worksheet_Activate()
Dim zelle As Range
Dim rng As Range
Dim lCol As Long
Dim lLastRow As Long
  With ActiveSheet
    For lCol = 2 To .UsedRange.Columns.Count
      lLastRow = .Cells(.Rows.Count, lCol).End(xlUp).Row
      Set rng = .Range(.Cells(2, lCol), .Cells(lLastRow, lCol))
      For Each zelle In rng
        If zelle.Value = Application.WorksheetFunction.Max(rng) Then
          zelle.Interior.ColorIndex = 6
        Else
          zelle.Interior.ColorIndex = xlNone
        End If
      Next
    Next lCol
  End With
End Sub

</code>

 

[Eric W]

Re: VBA Macro Highest Value

I'm sure you can adapt that to work. It's a bit less efficient since it uses loops instead of built-in functions, but if your sheet isn't large you may not notice.

If you think there's a max value, and it says there isn't, you may want to check to see if the value is stored as a value, or as text.

Good luck.

 

[hughhuyton]

Re: VBA Macro Highest Value

Hi Eric, so I checked and the value is stored as a value so I was confused as to why my code didn't work. I got the code below which finds the highest value on the first row only. How would I go about changing it so that it loops through each of the rows

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #011993; background-color: #ffffff}p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000; background-color: #ffffff}p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff; min-height: 13.0px}span.s1 {color: #011993}span.s2 {color: #000000}</style>Private Sub HighestValue()
Dim cell As Range


  For Each cell In ActiveSheet.Range("A1:U1")
    If cell.Value = Application.WorksheetFunction.Max(Range("A1:U1")) Then
      cell.Interior.ColorIndex = 6
    Else
      cell.Interior.ColorIndex = xlNone
    End If
  Next
End Sub

 

[hughhuyton]

Re: VBA Macro Highest Value

I just checked each row by changing the range and it works for each of them, but how would I get it to loop through each row?

 

[Eric W]

Re: VBA Macro Highest Value

Change:

 If cell.Value = Application.WorksheetFunction.Max(Range("A1:U1")) Then

to

 If cell.Value = Application.WorksheetFunction.Max(Range("A1:U1").Offset(cell.Row - Range("A1").Row, 0)) Then

 

[hughhuyton]

Re: VBA Macro Highest Value

Hi Eric, I tried the code but it doesn't seem to work. Would it otherwise be possible to include a vertical counter for offset?

 

[My Aswer Is This]

Re: VBA Macro Highest Value

What does this mean:

You said:
"I don't know how to get it to copy the highest value in each row and paste it further down the sheet. "

Where is further down the sheet

Hi Eric, sorry about this was not sure if I had to start a new thread. How would I go about trying to reference the cell of the highest value?

 

[My Aswer Is This]

Re: VBA Macro Highest Value

This script will put the max value in every row into Column "A" of every row.

Sub Find_max()
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim LastColumn As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = 1 To Lastrow
    LastColumn = Cells(i, Columns.Count).End(xlToLeft).Column
        For b = 1 To LastColumn
            Cells(i, 1).Value = Application.Max(Range(Cells(i, 1), Cells(i, LastColumn)))
        Next
    Next
Application.ScreenUpdating = True
End Sub

OK