Similar values in range make it as a KEY and sum function

Question

Cheers, everyone! It is a bit complicated to me to express the code below, but i will give it a shot. The code bellow is supposed to do the following things:

1.Check the range from columns D, E, H and M. Columns D, E and H have similar values in their range i.e.: D5 = V and D6 = V ; E5 = B and E6 = B ; H5 = A and H6 = A, while column M has digits as values i.e. M5 = 40 and M6 =70.

2.Column M (meaning Range(m5:m50) must sum up the values from M5 and M6: 40 + 70. The reason why it sums up is because range(D5:D6, E5:E6, H5:H6) have similar values in their columns. Only then the sumfunction must kick in range("m5:m50"), when all the other columns mentioned (D, E and H) have similar values in their range. Take it as key (D5&E5&H5 = VBA ; D6&E6&H6 = VBA). Both are similar. Then, If

3.Those 2 values from range("m5:m50") is > 100, both cells (M5 and M6 turn red). Otherwise, no action is taken.

Private Sub Worksheet_Change(ByVal Target As Range)

        Dim cell As Range

            Application.EnableEvents = False

        For Each cell In Target

                            If (cell.Range("d5:d50").Value) & (cell.Range("e5:e50").Value) & (cell.Range("h5:h50").Value) Then
                                Sum1 = Application.WorksheetFunction.Sum(cell.Range("m5:m50"))

                                If Sum1 > 100 Then

                                   cell.Range("m5:m50").Interior.Color = RGB(255, 0, 0)

                    Else
                                   cell.Range("m5:m50").Interior.Color = RGB(255, 255, 255)

                            End If
                            End If
                   Next

            Application.EnableEvents = True

        End Sub

My code doesn't seem to work, but I do not get also any error. I would really appreciate if someone can help me to fix my problem as I am out of ideas. Thanks in advance!

Answer 1

if my understanding is correct, I propose this adaptation to your code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(50) As Long
    Application.EnableEvents = False
    For i = 5 To 49
        sum1 = 0
        k = 0
        For j = i + 1 To 50
            If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) Then
                If sum1 = 0 Then sum1 = Cells(i, 13): k = 1: c(k) = i: Cells(i, 13).Interior.Color = RGB(255, 255, 255)
                sum1 = sum1 + Cells(j, 13)
                k = k + 1
                c(k) = j
                Cells(j, 13).Interior.Color = RGB(255, 255, 255)
            End If
        Next j
        If sum1 > 100 Then
            For j = 1 To k
                Cells(c(j), 13).Interior.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
    Application.EnableEvents = True
End Sub

A more robust version of the code

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, j As Long, sum1 As Long, k As Long, c(50) As Long
    Application.EnableEvents = False
    Range("M5:M50").Interior.Color = RGB(255, 255, 255)
    For i = 5 To 49
        k = 0
        For j = i + 1 To 50
            If Cells.Interior.Color <> RGB(255, 0, 0) Then
                If Cells(i, 4) & Cells(i, 5) & Cells(i, 8) <> "" Then
                    If Cells(i, 4) = Cells(j, 4) And Cells(i, 5) = Cells(j, 5) And Cells(i, 8) = Cells(j, 8) Then
                        If k = 0 Then sum1 = Cells(i, 13): k = 1: c(k) = i
                        sum1 = sum1 + Cells(j, 13)
                        k = k + 1
                        c(k) = j
                    End If
                End If
            End If
        Next j
        If sum1 > 100 Then
            For j = 1 To k
                Cells(c(j), 13).Interior.Color = RGB(255, 0, 0)
            Next j
        End If
    Next i
    Application.EnableEvents = True
End Sub

Answer 2

You appear to be writing your own conditional formatting. I've no idea why you're doing this, instead of using conditional formatting but if you insist on reinventing the wheel.. I believe the following will do what you want.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cell As Range
    Dim thisrowtext As String, nextrowtext As String

    Application.EnableEvents = False

    For Each cell In Me.Range("m5:m50")

        thisrowtext = cell.Offset(0, -9).Text & cell.Offset(0, -8).Text & cell.Offset(0, -5).Text
        nextrowtext = cell.Offset(1, -9).Text & cell.Offset(1, -8).Text & cell.Offset(1, -5).Text

        If thisrowtext = nextrowtext And cell.Value > 100 Then
                cell.Interior.Color = RGB(255, 0, 0)
        Else
                cell.Interior.Color = RGB(255, 255, 255)
        End If
    Next

    Application.EnableEvents = True

End Sub

Answer 3

Please try this code.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 18 Jan 2018

    Const FirstRow As Long = 5                  ' adjust as required
    Const LastRow As Long = 50                  ' adjust as required

    Dim Rng As Range                            ' M5:M50
    Dim Test1 As String                         ' concatenate values D:H
    Dim Test2 As Boolean                        ' Sum(M5:M50) > 100
    Dim Arr As Variant
    Dim R As Long

    With Target
        ' columns D, E, H, M
        If IsError(Application.Match(.Column, Array(4, 5, 8, 13), 0)) Then Exit Sub
        If .Row < FirstRow Or .Row > LastRow Then Exit Sub
    End With

    Arr = Range(Cells(FirstRow, "D"), Cells(LastRow, "H")).Value
    R = LBound(Arr)
    Test1 = Arr(R, 1) & Arr(R, 2) & Arr(R, 5)    ' columns D, E and H

    For R = (R + 1) To UBound(Arr)
        If StrComp(Test1, (Arr(R, 1) & Arr(R, 2) & Arr(R, 5)), vbTextCompare) Then Exit For
    Next R

    If R > UBound(Arr) Then
        Set Rng = Range(Cells(FirstRow, "M"), Cells(LastRow, "M"))
        Test2 = (Application.Sum(Rng) > 100)
    End If

    ' Setting range to colour red: adjust as required
    Set Rng = Range(Cells(FirstRow, "M"), Cells(FirstRow + 1, "M"))
    Rng.Interior.Color = IIf(Test2, 255, xlNone)
End Sub

I found your code at apparent variance with your task description with regard to which cells to colour red. My code follows your description (or how I understood it) and only colours M5:M6. However, I think you will be able to tweak this detail of the code easily enough, or any other part of it, once you learn how it works. Good luck!