zysteel
zysteel

Reputation: 3

How to use vba to find the maximum value in a group value in excel?

I have the following table as follow:

Name Storey Location Value1 Value2 Value3
B1   6F     0        11     22     33
B1   6F     1        21     32     10
B1   6F     2        10     21     35
B1   5F     0        12     21     34
B1   5F     1        23     33     9
B1   5F     2        12     20     36
B2   6F     1.1      8      20     21
...

What I want to get is to find out the maximum value of Value 1, Value 2, and Value 3 for each name (B1, B2, B3....) at the same location of different stories, and generate a new table Like below:

Name Location Value1 Value2 Value3
B1   0        12     22     34
B1   1        23     33     10
B1   2        12     21     36
B2   ...

Anyone know how to use VBA macro to do this?

Thanks!

Upvotes: 0

Views: 1539

Answers (2)

sam
sam

Reputation: 1304

Paste the below mentioned vba code in the module. You just need to modify variables source_rng(range which has raw data including headers) and target_rng (cell reference where you want to paste the result.

For eg if your raw data is in range H3:m10 then source_rng = .Range("h3:m10") - this range should include headers also.

Now you want to paste the results in cell "o3" then target_rng = .Range("o3")

Now paste the below mentioned code in Module

Sub t()

Dim myarr()

Dim myarr_max()

Dim source_rng As Range

Dim target_rng As Range

With ActiveSheet

    Set source_rng = .Range("h3:m10")
    Set target_rng = .Range("o3")
    target_rng.CurrentRegion.Clear
    source_rng.Copy
    target_rng.PasteSpecial (xlPasteAll)
    Selection.Columns(2).Delete shift:=xlToLeft
    .Range(Selection.Cells(2, 3), Selection.Cells(Selection.Rows.Count, Selection.Columns.Count)).ClearContents
    Selection.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

    For k = 1 To 3
                For Each target_cell In Selection.Columns(1).Cells
                    i = i + 1
                    If i <> 1 And target_cell <> "" Then
                        target_count = target_count + 1
                        For Each source_cell In source_rng.Columns(1).Cells
                            j = j + 1
                            If j <> 1 Then
                                 If target_cell.Value & "_" & target_cell.Offset(0, 1) = source_cell.Value & "_" & source_cell.Offset(0, 2) Then
                                    Counter = Counter + 1
                                    ReDim Preserve myarr(Counter - 1)
                                    myarr(Counter - 1) = source_cell.Offset(0, k + 2)
                                 End If
                            End If
                        Next source_cell

                            ReDim Preserve myarr_max(target_count - 1)
                            myarr_max(target_count - 1) = WorksheetFunction.Max(myarr)
                            Erase myarr
                            Counter = 0
                    End If

                Next target_cell
            .Range(.Cells(Selection.Rows(2).Row, Selection.Columns(k + 2).Column), .Cells(Selection.Rows(2).Row + UBound(myarr_max), Selection.Columns(k + 2).Column)) = WorksheetFunction.Transpose(myarr_max)
            Erase myarr_max
            target_count = 0
            i = 0
            j = 0

    Next k

End With

End Sub

Upvotes: 1

sabhareesh
sabhareesh

Reputation: 334

Try this formula: assuming Location column is from c2 to c8 and value 1 column fro d2 to d8

{=MAX(IF($C$2:$C$8=$C2,D$2:D$8,FALSE))}

type the formula and press ctrl+shift+enter

Upvotes: 0

Related Questions