Home > OS >  Compare Value of Cell with same Cell on the next round of the loop
Compare Value of Cell with same Cell on the next round of the loop

Time:02-03

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 nor IsMax. 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
  • Related