q-28138022.xlsx
Sub Macro1()
'
' Macro1 Macro
'
'
Cells.Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("C:C"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("AB:AB") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("O:O") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:AB")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Function MaxIf(rgToCheck As Range, Criteria As Variant, rgToMax As Range) As Variant
'Function tests rgToCheck for Criteria. Returns maximum of corresponding cells in rgToMax when rgToCheck cell satisfies Criteria.
'rgToCheck is range to be tested against Criteria
'Criteria may be a single value or an array of values
'rgToMax is range from which the maximum value is selected
'Function returns the maximum value if Criteria is a single value. It returns an array of maximums if Criteria is an array. _
=MaxIf(A1:A7, ">0",B1:B7) returns a single value _
=MaxIf(A1:A7, {">5", "<2"},B1:B7) returns a two column array of values _
=MaxIf(A1:A7, {">5"; "<2"},B1:B7) returns a two row array of values (semicolon instead of comma in array constant) _
=MaxIf(A1:A7, {">5", ">20"; "<2", "<1"}},B1:B7) returns a two column by two row array of values
MaxIf = MinMaxIf(rgToCheck, Criteria, rgToMax, False)
End Function
Private Function MinMaxIf(rgToCheck As Range, Criteria As Variant, rgToMinMax As Range, bMinimum As Boolean) As Variant
'Function tests rgToCheck for Criteria. Returns minimum/maximum of corresponding cells in rgToMinMax when rgToCheck cell satisfies Criteria.
'rgToCheck is range to be tested against Criteria
'Criteria may be a single value or an array of values
'rgToMinMax is range from which the minimum/maximum value is selected
'bMinimum is True when function returns a minimum value. It is False if a maximum value is returned.
'Function returns the minimum/maximum value if Criteria is a single value. It returns an array of minimums/maximums if Criteria is an array.
Dim i As Long, ii As Long, j As Long, jj As Long, n As Long, nCols As Long, nRows As Long, nnCols As Long, nnRows As Long
Dim d As Double
Dim iFirstCheck As Integer, iLastCheck As Integer, k As Integer
Dim vCheck As Variant, vCriteria As Variant, vResults As Variant
Dim wbCheck As Workbook
Set rgToCheck = Intersect(rgToCheck, rgToCheck.Worksheet.UsedRange) 'Avoid excessive runtime if needlessly passed entire row or column
nnCols = rgToCheck.Columns.Count
nnRows = rgToCheck.Rows.Count
If nnCols > rgToMinMax.Columns.Count Then
MinMaxIf = "#ColumnMatch"
Exit Function
ElseIf nnRows > rgToMinMax.Rows.Count Then
MinMaxIf = "#RowMatch"
Exit Function
End If
'Determine whether Criteria is an array. If so, establish its dimensions.
On Error Resume Next
If VarType(Criteria) >= vbArray Then
nCols = UBound(Criteria)
nRows = UBound(Criteria, 2)
If nCols = 0 Then nCols = 1
If nRows = 0 Then nRows = 1
ReDim vResults(1 To nRows, 1 To nCols)
Else
'ReDim vResults(1 To 1, 1 To 1)
n = 1
nRows = 1
nCols = 1
End If
n = nRows * nCols
On Error GoTo 0
For i = 1 To nRows
For j = 1 To nCols
d = IIf(bMinimum, 1E+308, -1E+308) 'Starting value
If n = 1 Then
vCriteria = Criteria
Else
If nCols = 1 Then
vCriteria = Criteria(i)
ElseIf nRows = 1 Then
vCriteria = Criteria(j)
Else
vCriteria = Criteria(i, j)
End If
End If
For ii = 1 To nnRows
For jj = 1 To nnCols
If (Application.CountIf(rgToCheck.Cells(ii, jj), vCriteria) = 1) And (rgToMinMax.Cells(ii, jj).Value <> "") Then
If bMinimum Then
d = Application.Min(d, rgToMinMax.Cells(ii, jj).Value)
Else
d = Application.Max(d, rgToMinMax.Cells(ii, jj).Value)
End If
End If
Next
Next
If n = 1 Then
vResults = IIf(Abs(d) = 1E+308, "#None", d)
Else
vResults(i, j) = IIf(Abs(d) = 1E+308, "#None", d)
End If
Next
Next
MinMaxIf = vResults
End Function
BradHave attached spreadsheet to assist and show what I mean. Hope someone can resolve this for me.With Excel 2010, you can array-enter formulas that refer to entire columns.
Title | # Comments | Views | Activity |
---|---|---|---|
cumlative total for mileage in excel | 35 | 32 | |
Excel 2007 Formula That Pulls Highest Degree From List | 2 | 39 | |
VBA excel copy code causing excel to crash | 3 | 32 | |
Word 2016 - Spelling/Grammar Check - Inconsistent behavior upon completion | 7 | 41 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
22 Experts available now in Live!