CODEWITHSUNDEEP
vbaexcel
Lani
Lani

Reputation: 15

find maximum value in column, select the corresponding values, copy and paste the values

Following my problem description: I have a table of variating column length. I want to search in column 4 for the minimum value then copy the row with minimum value to row 6

This is my Code:

Sub TestMax()

Dim searchArea As Range
Dim searchResult As Range
Dim rowMax As Long
Dim maxValue As Long
Dim columnSearch As Integer
Dim lastRow As Long

columnSearch = 4

'Select all the cells in the column you want to search down to the first empty cell.
lastRow = Sheets("V&A 16").Range("B1048576").End(xlUp).Row
Range(Cells(8, 4), Cells(lastRow, 4)).Select
Set searchArea = Range(Cells(8, 4), Cells(lastRow, 4))

'Determine the max value in the column.
maxValue = Application.Max(searchArea)

'Find the row that contains the max value.
Set searchResult = Sheets("V&A   16").Columns(columnSearch).Find(What:=maxValue, _
After:=Sheets("V&A 16").Cells(8, columnSearch), LookIn:=xlValues,     LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)


'Store the row that contains the minimum value in a variable.
rowMax = searchResult.Cells.Row
searchResult.Select
Range(Cells(rowMax, 3), Cells(rowMax, 13)).Select
Selection.Copy
Range("C6").Select
ActiveSheet.Paste Link:=True

End Sub

For Some reason I keep getting an error. The exact same code with Application.Min instead of max works though. Anny help on that? Thanks in Advance!!

Upvotes: 1

Views: 3603

Answers (2)

Martin Dreher
Martin Dreher

Reputation: 1564

While a proper solution might redoing most of the code and it can be argued about variable names and fixed values inside your code, I feel that likely won't help you in a step-by-step approach.

So, for starters, I would suggest the following (if you're new to VBA):

First, i would change

maxValue = Application.Max(searchArea)

to this

maxValue = Application.WorksheetFunction.Max(searchArea)

and then get the rowMax with

rowMax = Application.WorksheetFunction.Match(maxValue, searchArea, 0)

(you could ofc. nestle that)

Notes:

  • this will only work if there are only distinct values in column 4 (your search area). otherwise things might get a bit more complicated, which can hugely be omited by sorting the data first
  • rowmax will in this case return the targetrow INSIDE your searchrange.
  • since "searchrange" starts at a fix 8, you could do "rowmax = awf.match + 8"... that is, if you chose to NOT work with the searchArea-Range afterwards

EDIT: try this. as i said, while the approach is arguably a bit horrible, i recon that from a learning perspective it's best to keep what you did so far and only change it to "somehow work". hope that helps!

Sub TestMax()

Dim searchArea As Range

Dim rowMax As Long
Dim maxValue As Long

Dim lastRow As Long

columnSearch = 4

'get the lastrow
lastRow = Sheets("V&A 16").Range("B1048576").End(xlUp).Row

'set the search area
Set searchArea = Range(Cells(8, columnSearch), Cells(lastRow, columnSearch))

'Find the row that contains the max value inside the search area
rowMax = Application.WorksheetFunction.Match( _
    Application.WorksheetFunction.Max(searchArea), searchArea, 0)

'clumsily copy+paste (alternative: set values instead of copying)
'searchArea.Cells(rowMax, columnSearch).EntireRow.Copy
'Cells(6, columnSearch).EntireRow.Select
'ActiveSheet.Paste

' Alternative:
ActiveSheet.Rows(6).Cells().Value = searchArea.Rows(rowMax).EntireRow.Cells.Value
End Sub

Upvotes: 0

Arun Thomas
Arun Thomas

Reputation: 845

You could loop through the column 4 to find the row corresponding to the smallest value and copy that row to row no.6

(example : considering 10,000 rows of data to be checked)

Sub Foo()

smallest = Cells(1, 4).Value
i = 1

For i = 2 To 10000
    If Cells(i, 4).Value < smallest And Cells(i, 4).Value <> "" Then
        smallest = Cells(i, 4).Value
        Row = i
    End If
Next i

Rows(Row & ":" & Row).Select
Selection.Copy
Rows("6:6").Select
ActiveSheet.Paste

End Sub

Upvotes: 1

Related Questions