How to find highest value month wise with cell colour model

[PRADEEPB270]

I have an attachment file.
In this file,sheet 1 is my query and sheet "result" is my desired solution.

Can we find out in excel how to find the highest value month wise ( Prod.Qty and Sales Qty etc.) of a model with any cell colour ?

[MickG]

Try this, with you data starting "B4"

Sub MG04Feb32
Dim Rng As Range, Dn As Range, n As Long, Q As Variant, K As Variant
Set Rng = Range(Range("B4"), Range("B" & Rows.Count).End(xlUp))
Rng.Resize(, 4).Interior.ColorIndex = xlNone
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
For Each Dn In Rng
   If Not .Exists(Dn.Value) Then
         Dn.Interior.ColorIndex = 6
        .Add Dn.Value, Array(Dn.Offset(, 2), Dn.Offset(, 3))
   Else
        Q = .Item(Dn.Value)
            If Dn.Offset(, 2).Value > Q(0) Then Set Q(0) = Dn.Offset(, 2)
            If Dn.Offset(, 3).Value > Q(1) Then Set Q(1) = Dn.Offset(, 3)
        .Item(Dn.Value) = Q
    End If
Next
For Each K In .keys
    .Item(K)(0).Interior.ColorIndex = 6
    .Item(K)(1).Interior.ColorIndex = 6
Next K
End With
End Sub

Regards Mick

[PRADEEPB270]

Thanks for the solution.

But can it be apply for more than 2 columns.If yes,please see my fresh attachment and how can we do?

[PRADEEPB270]

can you help me to correct VBA codes in the same working ? How can it be apply on column F to J ? Please correct VBA codes working.

[YasserKhalil]

May be

Sub Test()
    Dim Rng As Range, Dn As Range, n As Long, Q As Variant, K As Variant, i As Long

    Application.ScreenUpdating = 0
        Set Rng = Range(Range("B4"), Range("B" & Rows.Count).End(xlUp))
        Rng.Resize(, 9).Interior.ColorIndex = xlNone
    
        With CreateObject("scripting.dictionary")
            .CompareMode = vbTextCompare
            For Each Dn In Rng
                If Not .Exists(Dn.Value) Then
                    Dn.Interior.ColorIndex = 6
                    .Add Dn.Value, Array(Dn.Offset(, 2), Dn.Offset(, 3), Dn.Offset(, 4), Dn.Offset(, 5), Dn.Offset(, 6), Dn.Offset(, 7), Dn.Offset(, 8))
                Else
                    Q = .Item(Dn.Value)
                    For i = 2 To 8
                        If Dn.Offset(, i).Value > Q(i - 2) Then Set Q(i - 2) = Dn.Offset(, i)
                        .Item(Dn.Value) = Q
                    Next i
                End If
            Next
            For Each K In .keys
                For i = 0 To 6
                    .Item(K)(i).Interior.ColorIndex = 6
                Next i
            Next K
        End With
    Application.ScreenUpdating = 1
End Sub

[PRADEEPB270]

Thanks for the help.

[YasserKhalil]

Cross-Post at this link
http://www.eileenslounge.com/viewtop...201615#p201615

[YasserKhalil]

You're welcome. Glad I can offer some help