Reputation: 3
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
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
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