Following scenario: I have different regions and different Product Groups. Region via DropDown in Cell A1 and Product Group via DropDown in Cell A2. In Cell C3 I have a formula which depends on the selection of A1 and A2. Now I want to loop through the different regions and get the max Value of C3 for each Product Group across all the different regions. An additional Problem is that sometimes C3 results in an error because there are no results for the combination in A1 and A2...
That's my attempt but unfortunately my skills are at the limit. Would really appreciate if you could help. thx
Sub FindMax()
Dim maxValue As Variant
Dim currentValue As Variant
Dim i As Integer
Dim j As Integer
Dim regions As Variant
Dim productGroups As Variant
regions = Array("Region 1", "Region 2", "Region 3")
productGroups = Array(1, 2, 3, 4, 5)
For i = LBound(regions) To UBound(regions)
Range("A1").Value = regions(i)
For j = LBound(productGroups) To UBound(productGroups)
Range("A2").Value = productGroups(j)
currentValue = Range("C3").Value
If j = LBound(productGroups) Then
maxValue = currentValue
ElseIf currentValue > maxValue Then
maxValue = currentValue
End If
Next j
Next i
MsgBox "The highest value for product group " & ws1.Range("A2").Value & " across all regions is: " & maxValue
End Sub
CodePudding user response:
Find the Maximum for All Combinations of Two Dropdowns
- If you are sure that there is at least one numeric value, you don't need the final if statement. If you are sure that there is at least one positive value, you neither need
IsFirstFound
norIsMax
. But why chance it?
Option Explicit
Sub MaxAcrossRegions()
Dim Regions(): Regions = Array("Region 1", "Region 2", "Region 3")
Dim ProductGroups(): ProductGroups = Array(1, 2, 3, 4, 5)
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim RegionCell As Range: Set RegionCell = ws.Range("A1")
Dim ProductGroupCell As Range: Set ProductGroupCell = ws.Range("A2")
Dim ValueCell As Range: Set ValueCell = ws.Range("C3")
Dim CurrValue As Variant, MaxValue As Double, r As Long, p As Long
Dim MaxProductGroup As String, MaxRegion As String
Dim IsFirstFound As Boolean, IsMax As Boolean
For r = LBound(Regions) To UBound(Regions)
RegionCell.Value = Regions(r)
For p = LBound(ProductGroups) To UBound(ProductGroups)
ProductGroupCell.Value = ProductGroups(p)
CurrValue = ValueCell.Value
If IsNumeric(CurrValue) Then
If IsFirstFound Then
If CurrValue > MaxValue Then IsMax = True
Else
IsFirstFound = True ' set once, on the first numeric value
IsMax = True
End If
If IsMax Then
MaxValue = CurrValue
MaxProductGroup = ProductGroups(p)
MaxRegion = Regions(r)
IsMax = False ' reset for next iteration
End If
End If
Next p
Next r
If IsFirstFound Then
MsgBox "The highest value for a product group across all regions is " _
& MaxValue & ", found in product group " & MaxProductGroup _
& " of region " & MaxRegion & ".", vbInformation
Else
MsgBox "No numeric values found.", vbCritical
End If
End Sub
Per Product Group
- The outer loop is looping through product groups while the inner loop is looping through regions. After each inner loop is finished, the result for the current product group is displayed.
Sub MaxPerProductGroup()
Dim Regions(): Regions = Array("Region 1", "Region 2", "Region 3")
Dim ProductGroups(): ProductGroups = Array(1, 2, 3, 4, 5)
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim RegionCell As Range: Set RegionCell = ws.Range("A1")
Dim ProductGroupCell As Range: Set ProductGroupCell = ws.Range("A2")
Dim ValueCell As Range: Set ValueCell = ws.Range("C3")
Dim CurrValue As Variant, MaxValue As Double, r As Long, p As Long
Dim MaxRegion As String, IsFirstFound As Boolean, IsMax As Boolean
For p = LBound(ProductGroups) To UBound(ProductGroups)
ProductGroupCell.Value = ProductGroups(p)
For r = LBound(Regions) To UBound(Regions)
RegionCell.Value = Regions(r)
CurrValue = ValueCell.Value
If IsNumeric(CurrValue) Then
If IsFirstFound Then
If CurrValue > MaxValue Then IsMax = True
Else
IsFirstFound = True
IsMax = True
End If
If IsMax Then
MaxValue = CurrValue
MaxRegion = Regions(r)
IsMax = False ' reset for next iteration
End If
End If
Next r
If IsFirstFound Then
MsgBox "The highest value for product group " & ProductGroups(p) _
& " across all regions is " & MaxValue _
& ", found in region " & MaxRegion & ".", _
vbInformation
IsFirstFound = False ' reset for next iteration
Else
MsgBox "No numeric values found in product group " _
& ProductGroups(p) & ".", vbCritical
End If
Next p
End Sub
Per Region
- The outer loop is looping through regions while the inner loop is looping through product groups. After each inner loop is finished, the result for the current region is displayed.
Sub MaxPerRegion()
Dim Regions(): Regions = Array("Region 1", "Region 2", "Region 3")
Dim ProductGroups(): ProductGroups = Array(1, 2, 3, 4, 5)
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim RegionCell As Range: Set RegionCell = ws.Range("A1")
Dim ProductGroupCell As Range: Set ProductGroupCell = ws.Range("A2")
Dim ValueCell As Range: Set ValueCell = ws.Range("C3")
Dim CurrValue As Variant, MaxValue As Double, r As Long, p As Long
Dim MaxProductGroup As String, IsFirstFound As Boolean, IsMax As Boolean
For r = LBound(Regions) To UBound(Regions)
RegionCell.Value = Regions(r)
For p = LBound(ProductGroups) To UBound(ProductGroups)
ProductGroupCell.Value = ProductGroups(p)
CurrValue = ValueCell.Value
If IsNumeric(CurrValue) Then
If IsFirstFound Then
If CurrValue > MaxValue Then IsMax = True
Else
IsFirstFound = True
IsMax = True
End If
If IsMax Then
MaxValue = CurrValue
MaxProductGroup = ProductGroups(p)
IsMax = False ' reset for next iteration
End If
End If
Next p
If IsFirstFound Then
MsgBox "The highest value for region " & Regions(r) _
& " across all product groups is " & MaxValue _
& ", found in product group " & MaxProductGroup & ".", _
vbInformation
IsFirstFound = False ' reset for the next iteration
Else
MsgBox "No numeric values found in region " _
& Regions(r) & ".", vbCritical
End If
Next r
End Sub